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