Functional programming: Sectioning function to a smaller domain

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:

Defaults (method = “def”) – Inserts the fixed values as defaults in the argument list.
Substitution (method = “sub”) – Rewrites the function body with the fixed values.
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: 0x5dbe22a24b68>

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.20  8.57 19.1   9.07
#>   (function (n = 8)  {     solve(toeplitz(1:n)) })()  9.61  9.83 10.9   9.98
#>  (function (n = 16)  {     solve(toeplitz(1:n)) })() 14.96 15.28 17.6  15.42
#>    uq  max neval cld
#>  12.8 56.7     5   a
#>  11.2 13.9     5   a
#>  19.3 22.9     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  25.8  25.8  68.8   68.8  111.8  111.8     2   a
#>   def40  65.7  65.7  66.6   66.6   67.4   67.4     2   a
#>   def60 152.6 152.6 159.6  159.6  166.5  166.5     2   a
#>   def80 301.9 301.9 304.0  304.0  306.1  306.1     2   a
#>  body20  27.7  27.7 387.6  387.6  747.6  747.6     2   a
#>  body40  63.4  63.4 469.2  469.2  874.9  874.9     2   a
#>  body60 157.9 157.9 550.0  550.0  942.2  942.2     2   a
#>  body80 299.0 299.0 662.2  662.2 1025.4 1025.4     2   a
#>   env20  25.9  25.9 430.4  430.4  835.0  835.0     2   a
#>   env40  65.2  65.2  72.3   72.3   79.5   79.5     2   a
#>   env60 155.6 155.6 161.7  161.7  167.9  167.9     2   a
#>   env80 317.8 317.8 318.1  318.1  318.4  318.4     2   a

Søren Højsgaard

Sectioning a function domain with section_fun()

How section_fun works

Benchmarking example

Sectioning a function domain with `section_fun()`

How `section_fun` works