# 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: 0x5a6228a7a138>

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)
    #> function (a, b, c = 4, d = 9)
    #> {
    #>     a + b + c + d
    #> }
    ## 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)) })() 22.6 24.0  55.6   24.3
    #>   (function (n = 8)  {     solve(toeplitz(1:n)) })() 26.3 27.0  33.2   27.3
    #>  (function (n = 16)  {     solve(toeplitz(1:n)) })() 39.7 41.2 259.3   42.4
    #>    uq    max neval
    #>  33.9  173.0     5
    #>  31.5   53.6     5
    #>  66.5 1106.6     5

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
    #>   def20  59.5  59.5   60.4   60.4   61.3   61.3     2
    #>   def40 175.3 175.3  179.7  179.7  184.0  184.0     2
    #>   def60 438.1 438.1  644.2  644.2  850.2  850.2     2
    #>   def80 883.9 883.9  887.7  887.7  891.5  891.5     2
    #>  body20  74.5  74.5 1349.2 1349.2 2623.8 2623.8     2
    #>  body40 199.8 199.8 1165.5 1165.5 2131.1 2131.1     2
    #>  body60 434.4 434.4 1597.0 1597.0 2759.5 2759.5     2
    #>  body80 854.4 854.4 2115.0 2115.0 3375.7 3375.7     2
    #>   env20  64.1  64.1   76.0   76.0   87.9   87.9     2
    #>   env40 197.7 197.7  215.5  215.5  233.4  233.4     2
    #>   env60 430.1 430.1  438.1  438.1  446.0  446.0     2
    #>   env80 863.4 863.4  890.0  890.0  916.7  916.7     2