# Functional programming: Sectioning function to a smaller domain

## Søren Højsgaard

## Sectioning a function domain with `section_fun()`

The `section_fun` utility in doBy creates a new function by fixing some arguments of an existing function. The result is a section of the original function, defined only on the remaining arguments.

For example, if you have:

$$ f(x,y) = x + y $$

then fixing \(x=10\) yields:

$$ f_x(y) = 10 + y $$

In `R` terms, `section_fun` lets you programmatically create such specialized versions.

## How `section_fun` works

`section_fun()` offers three ways to fix arguments:

1. Defaults (method = “def”) – Inserts the fixed values as defaults in the argument list.
2. Substitution (method = “sub”) – Rewrites the function body with the fixed values.
3. Environment (method = “env”) – Stores fixed values in an auxiliary environment.

Example:

    fun  <- function(a, b, c=4, d=9) {
        a + b + c + d
    }

    fun_def <- section_fun(fun, list(b=7, d=10))
    fun_def
    #> function (a, c = 4, b = 7, d = 10)
    #> {
    #>     a + b + c + d
    #> }
    fun_body <- section_fun(fun, list(b=7, d=10), method="sub")
    fun_body
    #> function (a, c = 4)
    #> {
    #>     b = 7
    #>     d = 10
    #>     a + b + c + d
    #> }
    fun_env <- section_fun(fun, list(b=7, d=10), method = "env")
    fun_env
    #> function (a, c = 4)
    #> {
    #>     . <- "use get_section(function_name) to see section"
    #>     . <- "use get_fun(function_name) to see original function"
    #>     args <- arg_getter()
    #>     do.call(fun, args)
    #> }
    #> <environment: 0x5d58c7af6838>

You can inspect the environment-based section:

    get_section(fun_env)
    #> $b
    #> [1] 7
    #>
    #> $d
    #> [1] 10
    ## same as: attr(fun_env, "arg_env")$args
    get_fun(fun_env)
    #> <srcref: file "" chars 1:9 to 3:1>
    ## same as: environment(fun_env)$fun

Example evaluations:

    fun(a=10, b=7, c=5, d=10)
    #> [1] 32
    fun_def(a=10, c=5)
    #> [1] 32
    fun_body(a=10, c=5)
    #> [1] 32
    fun_env(a=10, c=5)
    #> [1] 32

## Benchmarking example

Suppose you want to benchmark a function for different input values without writing repetitive code:

    inv_toep <- function(n) {
        solve(toeplitz(1:n))
    }

Instead of typing the following

    microbenchmark(
        inv_toep(4), inv_toep(8), inv_toep(16),
        times=3
    )

you can create specialized versions programmatically:

    n.vec  <- c(4, 8, 16)
    fun_list <- lapply(n.vec,
                       function(ni) {
                           section_fun(inv_toep, list(n=ni))
                       })
    fun_list
    #> [[1]]
    #> function (n = 4)
    #> {
    #>     solve(toeplitz(1:n))
    #> }
    #>
    #> [[2]]
    #> function (n = 8)
    #> {
    #>     solve(toeplitz(1:n))
    #> }
    #>
    #> [[3]]
    #> function (n = 16)
    #> {
    #>     solve(toeplitz(1:n))
    #> }

Inspect and evaluate:

    fun_list[[1]]
    #> function (n = 4)
    #> {
    #>     solve(toeplitz(1:n))
    #> }
    fun_list[[1]]()
    #>      [,1] [,2] [,3] [,4]
    #> [1,] -0.4  0.5  0.0  0.1
    #> [2,]  0.5 -1.0  0.5  0.0
    #> [3,]  0.0  0.5 -1.0  0.5
    #> [4,]  0.1  0.0  0.5 -0.4

To use with microbenchmark, we need expressions:

    bquote_list <- function(fun_list) {
        lapply(fun_list, function(g){
            bquote(.(g)())
        })
    }

We get:

    bq_fun_list <- bquote_list(fun_list)
    bq_fun_list
    #> [[1]]
    #> (function (n = 4)
    #> {
    #>     solve(toeplitz(1:n))
    #> })()
    #>
    #> [[2]]
    #> (function (n = 8)
    #> {
    #>     solve(toeplitz(1:n))
    #> })()
    #>
    #> [[3]]
    #> (function (n = 16)
    #> {
    #>     solve(toeplitz(1:n))
    #> })()
    bq_fun_list[[1]]
    #> (function (n = 4)
    #> {
    #>     solve(toeplitz(1:n))
    #> })()
    eval(bq_fun_list[[1]])
    #>      [,1] [,2] [,3] [,4]
    #> [1,] -0.4  0.5  0.0  0.1
    #> [2,]  0.5 -1.0  0.5  0.0
    #> [3,]  0.0  0.5 -1.0  0.5
    #> [4,]  0.1  0.0  0.5 -0.4

Now run:

    microbenchmark(
      list = bq_fun_list,
      times = 5
    )
    #> Unit: microseconds
    #>                                                 expr   min    lq mean median
    #>   (function (n = 4)  {     solve(toeplitz(1:n)) })()  8.93  9.04 23.3   10.1
    #>   (function (n = 8)  {     solve(toeplitz(1:n)) })() 10.04 10.60 12.0   12.4
    #>  (function (n = 16)  {     solve(toeplitz(1:n)) })() 15.96 16.35 18.7   17.1
    #>    uq  max neval cld
    #>  12.9 75.4     5   a
    #>  13.2 13.7     5   a
    #>  19.1 25.1     5   a

Running the code below provides a benchmark of the different ways of sectioning in terms of speed.

    n.vec  <- seq(20, 80, by=20)
    fun_def <- lapply(n.vec,
                      function(n){
                          section_fun(inv_toep, list(n=n), method="def")
                      })
    fun_body <- lapply(n.vec,
                      function(n){
                          section_fun(inv_toep, list(n=n), method="sub")
                      })
    fun_env <- lapply(n.vec,
                      function(n){
                          section_fun(inv_toep, list(n=n), method="env")
                      })

    names(fun_def)  <- paste0("def", n.vec)
    names(fun_body) <- paste0("body", n.vec)
    names(fun_env)  <- paste0("env", n.vec)

    bq_fun_list <- bquote_list(c(fun_def, fun_body, fun_env))
    bq_fun_list |> head()
    #> $def20
    #> (function (n = 20)
    #> {
    #>     solve(toeplitz(1:n))
    #> })()
    #>
    #> $def40
    #> (function (n = 40)
    #> {
    #>     solve(toeplitz(1:n))
    #> })()
    #>
    #> $def60
    #> (function (n = 60)
    #> {
    #>     solve(toeplitz(1:n))
    #> })()
    #>
    #> $def80
    #> (function (n = 80)
    #> {
    #>     solve(toeplitz(1:n))
    #> })()
    #>
    #> $body20
    #> (function ()
    #> {
    #>     n = 20
    #>     solve(toeplitz(1:n))
    #> })()
    #>
    #> $body40
    #> (function ()
    #> {
    #>     n = 40
    #>     solve(toeplitz(1:n))
    #> })()

    mb <- microbenchmark(
      list  = bq_fun_list,
      times = 2
    )
    mb
    #> Unit: microseconds
    #>    expr   min    lq  mean median     uq    max neval cld
    #>   def20  29.3  29.3  38.7   38.7   48.1   48.1     2   a
    #>   def40  76.4  76.4  80.7   80.7   85.1   85.1     2   a
    #>   def60 168.9 168.9 181.9  181.9  195.0  195.0     2   a
    #>   def80 343.8 343.8 344.6  344.6  345.5  345.5     2   a
    #>  body20  42.9  42.9 427.8  427.8  812.6  812.6     2   a
    #>  body40 104.6 104.6 535.5  535.5  966.4  966.4     2   a
    #>  body60 267.4 267.4 691.1  691.1 1114.9 1114.9     2   a
    #>  body80 518.9 518.9 961.4  961.4 1404.0 1404.0     2   a
    #>   env20  28.3  28.3  41.0   41.0   53.6   53.6     2   a
    #>   env40  84.4  84.4 620.9  620.9 1157.5 1157.5     2   a
    #>   env60 184.5 184.5 232.9  232.9  281.4  281.4     2   a
    #>   env80 345.0 345.0 353.5  353.5  362.1  362.1     2   a