Functional programming

At it's core, R is a functional programming (FP) language which means it supports "first class functions", functions that can be:

created anonymously,
assigned to variables and stored in data structures,
returned from functions,
passed as arguments to other functions

This chapter will explore the consequences of R's functional nature and introduce a new set of techniques for removing redundancy and duplication in your code.

Each technique is relatively simple by itself, but combined they provide a powerful set of techniques. They are especially useful when you want to solve a large class of problems with a small set of building blocks and tools to connect them together.

We'll start with a motivating example, showing how you can use functional programming techniques to reduce duplication in some typical code for cleaning data and summarising data. This example will introduce some of the most important functional programming concepts, which we will then dive into in more detail:

Anonymous functions, functions that don't have a name
Closures, functions written by other functions
Functionals, functions that that a function as a input
Function operators, functions that both input and output functions
Lists of functions

The final two sections are case studies showing how we can combine multiple techniques to solve real problems with a minimum of duplication, in a way that is easy to modify when our problem changes. The first case study will explore numerical integration showing how we can build a family of composite integration tools starting from very simple primitives. The second case study makes extensive use of function operations to build a mini-language to guard against incorrect function input.

Motivation

Imagine you've loaded a data file that uses -99 to represent missing values. When you first start writing R code, you might write code like this, dealing with duplication by using copy-and-paste:

# Generate a sample dataset
set.seet(1014)
df <- data.frame(replicate(6, sample(c(1:10, -99), 10, rep = T)))
names(df) <- letters[1:6]

# Fix missing values
df$a[df$a == -99] <- NA
df$b[df$b == -99] <- NA
df$c[df$c == -98] <- NA
df$d[df$d == -99] <- NA
df$e[df$e == -99] <- NA
df$f[df$g == -99] <- NA

One problem with using copy-and-paste is that it's easy to make mistakes (can you spot the two in the block above?). The root cause is that one idea, that missing values are represent as -99, is duplicated many times. Duplication is bad because it allows for inconsistencies (aka bugs), and it mades the code harder to change: if the the representation of missing value changes from -99 to 9999, then we need to make the change in many places, not just one.

The "do not repeat yourself", or DRY, principle, was popularised by the pragmatic programmers, Dave Thomas and Andy Hunt. This principle states that "every piece of knowledge must have a single, unambiguous, authoritative representation within a system". Adhering to this principle prevents bugs caused by inconsistencies, and makes software that is easier to adapt to changing requirements. The ideas of FP are important because they give us new tools to reduce duplication.

We can start applying some of the ideas of FP to our example by writing a function that fixes the missing values in a single vector:

fix_missing <- function(x) {
  x[x == -99] <- NA
  x
}
df$a <- fix_missing(df$a)
df$b <- fix_missing(df$b)
df$c <- fix_missing(df$c)
df$d <- fix_missing(df$d)
df$e <- fix_missing(df$e)
df$f <- fix_missing(df$e)

This reduces the scope for errors, but we've still made one, because we've repeatedly applied our function to each column. To prevent that error from occuring we need to remove the copy-and-paste application of our function to each column. To do this, we need to combine, or compose, our function for correcting missing values with a function that does something to each column in a data frame, like lapply().

lapply() takes three inputs: a list, a function, and other arguments to pass to the function. It applies the function to each element of the list and returns the resulting list (since data frames are also lists, lapply() also works on data frames). lapply(x, f, ...) is equivalent to the following for loop:

out <- vector("list", length(x))
for (i in seq_along(x)) {
  out[[i]] <- f(x[[i]], ...)
}

The real lapply() is rather more complicated since it's implemented in C for efficiency, but the essence of the algorithm is the same. lapply() is a higher-order-function (HOF), because it takes a function as one of its arguments. HOFs are an important part of functional programming and we'll learn more about them below.

We can apply lapply() to our problem with one small trick: rather than simply assigning the results to df we assign them to df[], so R's usual subsetting rules take over and we get a data frame instead of a list.

fix_missing <- function(x) {
  x[x == -99] <- NA
  x
}
df[] <- lapply(df, fix_missing)

As well as being more compact, there are two main advantages of this code over our previous code:

If the representation of missing values changes, we only need to change it in one place, and there is no way for some columns to be treated differently than others.
Our code works regardless of the number of columns in the data frame, and there is no way to miss a column because of a copy and paste error.

The key idea here is composition. We take two simple functions, one which does something to each column, and one which replaces -99 with NA, and compose them to replace -99 with NA in every column. An important technique for effective FP is writing simple functions than can be understood in isolation and then composed together to solve complex problems.

What if different columns use different indicators for missing values? You again might be tempted to copy-and-paste:

fix_missing_99 <- function(x) {
  x[x == -99] <- NA
  x
}
fix_missing_999 <- function(x) {
  x[x == -999] <- NA
  x
}
fix_missing_9999 <- function(x) {
  x[x == -999] <- NA
  x
}

But as previously, it's easy to create bug. The next functional programming tool we'll talk about helps deal with this sort of duplication: we have multiple functions that all follow the same basic template. Closures, functions that return functions, allow us to make many functions from a template:

missing_fixer <- function(na_value) {
  function(x) {
    x[x == na_value] <- NA
    x
  }
}
fix_missing_99 <- missing_fixer(-99)
fix_missing_999 <- missing_fixer(-999)
fix_missing_9999 <- missing_fixer(-9999)

Let's now consider a new problem: once we've cleaned up our data, we might want to compute the same set of numerical summaries for each variable. We could write code like this:

mean(df$a)
median(df$a)
sd(df$a)
mad(df$a)
IQR(df$a)

mean(df$b)
median(df$b)
sd(df$b)
mad(df$b)
IQR(df$b)

mean(df$c)
median(df$c)
sd(df$c)
mad(df$c)
IQR(df$c)

But we'd be better off identifying the sources of duplication and then removing them. Take a minute or two to think about how you might tackle this problem before reading on.

One approach would be to write a summary function and then apply it to each column:

summary <- function(x) { 
  c(mean(x), median(x), sd(x), mad(x), IQR(x))
}
lapply(df, summary)

But there's still some duplication here. If we make the summary function slightly more realistic, it's easier to see the duplication:

summary <- function(x) { 
 c(mean(x, na.rm = TRUE), 
   median(x, na.rm = TRUE), 
   sd(x, na.rm = TRUE), 
   mad(x, na.rm = TRUE), 
   IQR(x, na.rm = TRUE))
}

All five functions are called with the same arguments (x and na.rm) which we had to repeat five times. As before, this duplication makes our code fragile: it makes it easier to introduce bugs and harder to adapt to changing requirements.

We can take advantage of another functional programming technique, storing functions in lists, to remove this duplication:

summary <- function(x) {
  funs <- c(mean, median, sd, mad, iqr)
  lapply(funs, function(f) f(x))
}

The remainder of this chapter will discuss each technique in more detail. But before we can start on those more complicated techniques, we need to start by revising a simple functional programming tool, anonymous functions.

Anonymous functions

In R, functions are objects in their own right. They aren't automatically bound to a name, unlike many other programming languages. You might have noticed this already, because when you create a function, you use the usual assignment operator to give it a name. Functions that don't have a name are called anonymous functions.

Given the name of a function, like "mean", it's possible to find the function using match.fun(). You can't do the opposite: given the object f <- mean, there's no way to find its name. Not all functions have a name, and some functions have more than one name.

We use anonymous functions when it's not worth the effort of creating a named function:

lapply(mtcars, function(x) length(unique(x)))
Filter(function(x) !is.numeric(x), mtcars)
integrate(function(x) sin(x) ^ 2, 0, pi)

Unfortunately the default R syntax for anonymous functions is quite verbose. To make things a little more concise, pryr provides f():

lapply(mtcars, f(length(unique(x))))
Filter(f(!is.numeric(x)), mtcars)
integrate(f(sin(x) ^ 2), 0, pi)

I'm not still sure whether I like this style or not, but it sure is compact!

Like all functions in R, anoynmous functions have formals(), a body(), and a parent environment():

formals(function(x = 4) g(x) + h(x))
body(function(x = 4) g(x) + h(x))
environment(function(x = 4) g(x) + h(x))

You can call anonymous functions without giving them a name, but the code is a little tricky to read because you must use parentheses in two different ways: to call a function, and to make it clear that we want to call the anonymous function function(x) 3, not inside our anonymous function call a function called 3 (which isn't a valid function name!):

(function(x) 3)()

# Exactly the same as
f <- function(x) 3
f()

function(x) 3()

The syntax extends in a straightforward way if the function has parameters:

(function(x) x)(3)
(function(x) x)(x = 4)

If you're calling an anonymous function in a complicated way, it's a good sign that it needs a name.

One of the most common uses for anonymous functions is to create closures, functions made by other functions. Closures are the topic of the next section.

Exercises

Use lapply() and an anonymous function to find the coefficient of variation (the standard deviation divided by the mean) for all columns in the mtcars dataset

Introduction to closures

"An object is data with functions. A closure is a function with data." --- John D Cook

One important use of anonymous functions is to create small functions that it's not worth naming. The other important of use of anonymous functions is to create a closure, a function written by another function. Closures are so called because they enclose the environment of the parent function, and can access all variables and parameters in that function. This is useful because it allows us to have two levels of parameters. One level of parameters (the parent) controls how the function works; the other level (the child) does the work. The following example shows how we can use this idea to generate a family of power functions. The parent function (power()) creates child functions (square() and cube()) that do the work.

power <- function(exponent) {
  function(x) x ^ exponent
}

square <- power(2)
square(2)
square(4)

cube <- power(3)
cube(2)
cube(4)

In R, almost every function is a closure, because all functions remember the environment in which they are created, typically either the global environment, if it's a function that you've written, or a package environment, if it's a function that someone else has written. The only exception are primitive functions, which call directly in to C.

When you print a closure, you don't see anything terribly useful:

square
cube

That's because the function itself doesn't change; it's the enclosing environment, e.g. environment(square), that's different. One way to see the contents of the environment is to convert it to a list:

as.list(environment(square))
as.list(environment(cube))

Another way to see what's going on is to use pryr::unenclose(), which substitutes the variables defined in the enclosing environment into the original functon:

library(pryr)
unenclose(square)
unenclose(cube)

Note that the parent environment of the closure is the environment created when the parent function is called:

power <- function(exponent) {
  print(environment())
  function(x) x ^ exponent
}
zero <- power(0)
environment(zero)

This environment normally disappears once the function finishes executing, but because we return a function, the environment is captured and attached to the new function. Each time we re-run power() a new environment is created, so each function produced by power is independent.

Closures are useful for making function factories, and are one way to manage mutable state in R.

Function factories

We've already seen one example of a function factory, power(). We might also need a function if our initial example was slightly more complicated: imagine the missing values were inconsistently recorded and in some columns they were -99, in others they were 9999 or ".". Rather than copying, pasting and modifying, we could use a closure to create a remove missing function for each case:

missing_remover <- function(na) {
  x[x == na] <- NA
  x
}
remove_99 <- missing_remover(-99)
remove_9999 <- missing_remover(-9999)
remove_dot <- missing_remover(".")

We'll see another compelling using function factories when we learn more about functionals; they are very useful for maximum likelihood problems.

Mutable state

Having variables at two levels makes it possible to maintain state across function invocations by allowing a function to modify variables in the environment of its parent. The key to managing variables at different levels is the double arrow assignment operator (<<-). Unlike the usual single arrow assignment (<-) that always assigns in the current environment, the double arrow operator will keep looking up the chain of parent environments until it finds a matching name. (Environments has more details on how it works)

This makes it possible to maintain a counter that records how many times a function has been called, as shown in the following example. Each time new_counter is run, it creates an environment, initialises the counter i in this environment, and then creates a new function.

new_counter <- function() {
  i <- 0
  function() {
    i <<- i + 1
    i
  }
}

The new function is a closure, and its environment is the enclosing environment. When the closures counter_one and counter_two are run, each one modifies the counter in its enclosing environment and then returns the current count.

counter_one <- new_counter()
counter_two <- new_counter()

counter_one() # -> [1] 1
counter_one() # -> [1] 2
counter_two() # -> [1] 1

We can use our environment inspection tools to see what's going on here:

as.list(environment(counter_one))
as.list(environment(counter_two))

The counters get around the "fresh start" limitation by not modifying variables in their local environment. Since the changes are made in the unchanging parent (or enclosing) environment, they are preserved across function calls.

What happens if we don't use a closure? What happens if we only use <- instead of <<-? Make predictions about what will happen if you replace new_counter() with each variant below, then run the code and check your predictions.

i <- 0
new_counter2 <- function() {
  i <<- i + 1
  i
}
new_counter3 <- function() {
  i <- 0
  function() {
    i <- i + 1
    i
  }
}

Modifying values in a parent environment is an important technique because it is one way to generate "mutable state" in R. Mutable state is hard to achieve normally, because every time it looks like you're modifying an object, you're actually creating a copy and modifying that. That said, if you do need mutable objects, it's usually better to use the R5 OO system, except in the simplest of cases. R5 objects are easier to document, and provide easier ways to inherit behaviour across functions.

The power of closures is tightly coupled to another important class of functions: higher-order functions (HOFs), which include functions that take functions as arguments. Mathematicians distinguish between functionals, which accept a function and return a scalar, and function operators, which accept a function and return a function. Integration over an interval is a functional, the indefinite integral is a function operator. The following two chapters discuss functionals and function operators in turn.

Exercises

What does the following statistical function do? What would be a better name for it? (The existing name is a bit of a hint)

bc <- function(lambda) {
  if (lambda == 0) {
    function(x) log(x)
  } else {
    function(x) (x ^ lambda - 1) / lambda
  }
}

Create a function that creates functions that compute the ith central moment of a numeric vector. You can test it by running the following code:

m1 <- moment(1)
m2 <- moment(2)

x <- runif(m1, 100)
stopifnot(all.equal(m1(x), mean(x)))
stopifnot(all.equal(m2(x), var(x) * 99 / 100))

What does approxfun() return? What does it return? What does the ecdf() function do? What does it return?

Functionals

"To become significantly more reliable, code must become more transparent. In particular, nested conditions and loops must be viewed with great suspicion. Complicated control flows confuse programmers. Messy code often hides bugs." --- Bjarne Stroustrup

Higher-order functions encompass any functions that either take a function as an input or return a function as output. We've seen our first example of a higher-order function, the closures, functions returned by another function. The complement to a closure is a functional, a function that takes a function as an input and returns a vector as output. In R, functionals are commonly used as a way to eliminate for loops.

For loops have a bad rap in R, with many programmers trying to eliminate their use at all costs. In the performance chapter we'll explore their speed, which is not as bad as many people believe (although depending on what you're trying to do, there may be more efficient ways). To me, the real downside of for loops is that they're not very expressive: if you use a functional instead, you can more clearly express what you're doing, and as a side-effect you're likely to make fewer errors, maybe even get better performance.

We've seen one example of a functional already: lapply(). lapply() represents the idea of doing something to each element of a list and storing the results in another list. It's informative to look at a pure-R implementation that uses a for loop:

lapply2 <- function(x, f, ...) {
  out <- vector("list", length(x))
  for (i in seq_along(x)) {
    out[[i]] <- f(x[[i]], ...)
  }
  out
}

lapply() is just a wrapper around a common for-loop pattern. There are a number of other wrappers for common for-loops, which we'll explore in

The three most important HOFs you're likely to use are from the apply family. The family includes apply, lapply, mapply, tapply, sapply, vapply, and by. Each of these functions processes breaks up a data structure in some way, applies the function to each piece and then joins them back together again. The **ply functions of the plyr package which attempt to unify the base apply functions by cleanly separating based on the type of input they break up and the type of output that they produce. However, most of those functions are most useful for data analysis, rather than programming, so in this section we'll focus on the three functions that you're most likely to use as an R programming: lapply, vapply and Map.

for(x in xs) {}
for(i in seq_along(xs)) {}
for(nm in names(xs)) {}

`sapply` and `vapply`

sapply() and vapply() are very similar to lapply() except they will simplify their output to produce an atomic vector. sapply() will guess the output, while with vapply() you have to be explicit. sapply() is useful for interactive use because it's a minimum amount of typing, but if you use it inside your functions you will get weird errors if you supply the wrong type of input. vapply() is more verbose, but gives more informative errors messages (it will never fail silently), so is better suited for programming with.

sapply(mtcars, is.numeric)
vapply(mtcars, is.numeric, logical(1))

A pure R implementation of sapply and vapply follows:

sapply2 <- function(x, f, ...) {
  res <- lapply2(x, f, ...)
  simplify2array(res)
}

vapply2 <- function(x, f, f.value, ...) {
  out <- matrix(rep(f.value, length(x)), nrow = length(x))
  for (i in seq_along(x)) {
    res <- f(x, ...)
    stopifnot(
      length(res) == length(f.value), 
      typeof(res) == typeof(f.value)
    )
    out[i, ] <- res
  }
  out
}

The real implementations of vapply() is somewhat more complicated because it takes more care with error messages, and is implemented in C for efficiency.

`Map` (and `mapply`)

Map is useful when you have multiple sets of inputs that you want to iterate over in parallel. Map(f, x, y, z) is equivalent to

for(i in seq_along(x)) {
  output[[i]] <- f(x[[i]], y[[i]], z[[i]])
}

In comparison with lapply(), Map() iterates over all of its arguments, not just the first one:

a <- c(1, 2, 3)
b <- c("a", "b", "c")

str(lapply(FUN = list, a, b))
str(Map(f = list, a, b))

What if you have arguments that you don't want to be split up? Use an anonymous function!

Map(function(x, y) f(x, y, zs), xs, ys)

You may be more familiar with mapply() than Map(). I prefer Map() because:

it is equivalent to mapply with simplify = FALSE, which is almost always what you want.
mapply also has the MoreArgs arguments with which you can provide a list of extra arguments that will be supplied as is to each call; however this breaks R's usual lazy evaluation semantics, and is better done with an anonymous function.

In brief, mapply() is much more complicated for little gain.

Recursively applying a function

out <- x[1]
for(i in seq(2, length(x)) {
  out <- f(out, x[i])
}

Reduce recursively reduces a vector to a single value by first calling f with the first two elements, then the result of f and the second element and so on.

If x = 1:5 then the result would be f(f(f(f(1, 2), 3), 4), 5).

If right = TRUE, then the function is called in the opposite order: f(1, f(2, f(3, f(4, 5)))).

for(i in seq(2, length(x)) {
  out <- f(x[i], out)
}

Reduce is useful for implementing many types of recursive operations: merges, finding smallest values, intersections, unions.

Logical predicates

The first important family of higher-order functions manipulate vectors. They each take a function as their first argument, and a vector as their second argument.

The first three functions take a logical predicate, a function that returns either TRUE or FALSE. The predicate function does not need to be vectorised, as all three functions call it element by element.

Filter: returns a new vector containing only elements where the predicate is TRUE.
Find: return the first element that matches the predicate (or the last element if right = TRUE).
```
for(i in seq_along(x)) {
  if (f(x[[i]])) return(x[[i]])
}
```
Position: return the position of the first element that matches the predicate (or the last element if right = TRUE).
```
for(i in seq_along(x)) {
if (f(x[[i]])) return(i)
}
```

The following example shows some simple uses:

x <- 200:250

is.even <- function(x) x %% 2 == 0
is.odd <- Negate(is.even)
is.prime <- function(x) gmp::isprime(x) > 1

Filter(is.prime, x)
# [1] 211 223 227 229 233 239 241

Find(is.even, x)
# 200
Find(is.odd, x)
# 201

Position(is.prime, x, right = T)
# 42

Matrix families

# apply
for(i in seq_len(dims(x)[i])) {
  x[i, ,] <- f(x[i, , ])
}
# sweep
for(i in ) {
  x[i , , ] <- f(x[i , , ], y[i])
}
# outer
out <- matrix(nrow = length(x), ncol = length(y))
for (i in seq_along(x)) {
  for(j in seq_along(y)) {
    out[i, j] <- f(x, y)
  }
}
# tapply ?
# replicate

Other types of loops

That there are wide class of for loops that can not be simplified to a single existing function call in R.

modifying multiple elements in each cycle
you don't know how long the answer will be. Examples: how long until you roll two sixes.

`while(TRUE) {if (condition) break;}

i <- 0
while(TRUE) {
  if (runif(1) > 0.9)
  i <- i + 1
}

you need to refer to multiple elements in the vector. e.g. diff, Fibonacci series, recursion. Or you're doing a simulation where new values are based on the old.

It's certainly possible to write functions that encapsulate these types of loops, but they are not built in to R. Whether or not it's worth building your own function depends on how often you'll be using, and how much more expressive a better function name would be.

Exercises

Implement the arg_max function. It should take a function, and a vector of inputs, returning the elements of the input where the function returns the highest number. For example, arg_max(-10:5, function(x) x ^ 2) should return -10. arg_max(-5:5, function(x) x ^ 2) should return c(-5, 5). Also implement the matching arg_min.

Mathematical functionals

Higher order functions arise often in mathematics. In this section we'll explore some of the built in mathematical HOF functions in R. There are three functions that work with a 1d numeric function:

integrate: integrate it over a given range
uniroot: find where it hits zero over a given range
optimise: find location of minima (or maxima)

Let's explore how these are used with a simple function:

integrate(sin, 0, pi)
uniroot(sin, pi * c(1 / 2, 3 / 2))
optimise(sin, c(0, 2 * pi))
optimise(sin, c(0, pi), maximum = TRUE)

There is one function that works with a more general n-dimensional numeric function, optim, which finds the location of a minima.

In statistics, optimisation is often used for maximum likelihood estimation. Maximum likelihood estimation is a natural match to closures because the arguments to a likelihood fall into two groups: the data, which is fixed for a given problem, and the parameters, which will vary as we try to find a maximum numerically. This naturally gives rise to an approach like the following:

# Negative log-likelihood for Poisson distribution
poisson_nll <- function(x) {
  n <- length(x)
  function(lambda) {
    n * lambda - sum(x) * log(lambda) # + terms not involving lambda
  }
}

nll1 <- poisson_nll(c(41, 30, 31, 38, 29, 24, 30, 29, 31, 38)) 
nll2 <- poisson_nll(c(6, 4, 7, 3, 3, 7, 5, 2, 2, 7, 5, 4, 12, 6, 9)) 

optimise(nll1, c(0, 100))
optimise(nll2, c(0, 100))

Function operators

A related use of function factories is to tweak the way that existing functions behase. Two built-in examples of this are functions Negate and Vectorise:

Negate takes a function that returns a logical vector, and returns the negation of that function. This can be a useful shortcut when the function you have returns the opposite of what you need.
```
Negate <- function(f) {
  f <- match.fun(f)
  function(...) !f(...)
}

(Negate(is.null))(NULL)
```

Vectorize takes a non-vectorised function and vectorises with respect to the arguments given in the vectorise.args parameter. This doesn't give you any magical performance improvements, but it is useful if you want a quick and dirty way of making a vectorised function.

An mildly useful extension of sample would be to vectorize it with respect to size: this would allow you to generate multiple samples in one call.
```
sample2 <- Vectorize(sample, "size", SIMPLIFY = FALSE)
sample2(1:10, rep(5, 4))
sample2(1:10, 2:5)
```
In this example we have used SIMPLIFY = FALSE to ensure that our newly vectorised function always returns a list. This is usually a good idea.

Vectorize does not work with primitive functions.

Exercises

What does the following function do? What would be a good name for it?
```
g <- function(f1, f2) {
  function(...) f1(...) || f2(...)
} 
Filter(g(is.character, is.factor), mtcars)
```
Can you extend the function to take any number of functions as input? You'll probably need a loop.
Create a function pick(), that takes an index, i, as an argument and returns a function an argument x that subsets x with i.
```
lapply(mtcars, pick(5))
```
Write a function and that takes two function as input and returns a single function as an output that ands together the results of the two functions. Write a function or that combines the results with or. Add a not function and you now have a complete set of boolean operators for predicate functions.
Create a function called timer that takes a function as input and returns as function as output. The new function should perform exactly the same as the old function, except that it should also print out how long it took to run.

What does the following function do? What would be a good name for it?

f <- function(g) {
  stopifnot(is.function(g))
  result <- NULL
  function(...) {
    if (is.null(result)) {
      result <- g(...)
    }
    result
  }
}

Lists of functions

In R, functions can be stored in lists. Together with closures and higher-order functions, this gives us a set of powerful tools for reducing duplication in code.

We'll start with a simple example: benchmarking, when you are comparing the performance of multiple approaches to the same problem. For example, if you wanted to compare a few approaches to computing the mean, you could store each approach (function) in a list:

compute_mean <- list(
  base = function(x) mean(x),
  sum = function(x) sum(x) / length(x),
  manual = function(x) {
    total <- 0
    n <- length(x)
    for (i in seq_along(x)) {
      total <- total + x[i] / n
    }
    total
  }
)

Calling a function from a list is straightforward: just get it out of the list first:

x <- runif(1e5)
system.time(compute_mean$base(x))
system.time(compute_mean[[2]](x))
system.time(compute_mean[["manual"]](x))

If we want to call all functions to check that we've implemented them correctly and they return the same answer, we can use lapply, either with an anonymous function, or a new function that calls it's first argument with all other arguments:

lapply(compute_mean, function(f) f(x))

call_fun <- function(f, ...) f(...)
lapply(compute_mean, call_fun, x)

We can time every function on the list with lapply or Map along with a simple anonymous function:

lapply(compute_mean, function(f) system.time(f(x)))
Map(function(f) system.time(f(x)), compute_mean)

If timing functions is something we want to do a lot, we can add another layer of abstraction: a closure that automatically times how long a function takes. We then create a list of timed functions and call the timers with our specified x.

timer <- function(f) {
  force(f)
  function(...) system.time(f(...))
}
timers <- lapply(compute_mean, timer)
lapply(timers, call_fun, x)

Another useful example is when we want to summarise an object in multiple ways. We could store each summary function in a list, and run each function with lapply and call_fun:

funs <- list(
  sum = sum,
  mean = mean,
  median = median
)
lapply(funs, call_fun, 1:10)

What if we wanted to modify our summary functions to automatically remove missing values? One approach would be make a list of anonymous functions that call our summary functions with the appropriate arguments:

funs2 <- list(
  sum = function(x, ...) sum(x, ..., na.rm = TRUE),
  mean = function(x, ...) mean(x, ..., na.rm = TRUE),
  median = function(x, ...) median(x, ..., na.rm = TRUE)
)

But this leads to a lot of duplication - each function is almost identical apart from a different function name. We could write a closure to abstract this away:

remove_missings <- function(f) {
  function(...) f(..., na.rm = TRUE)
}
funs2 <- lapply(funs, remove_missings)

We could also take a more general approach. A useful function here is Curry (named after the famous computer scientist Haskell Curry, not the food), which implements "partial function application". What the curry function does is create a new function that passes on the arguments you specify. A example will make this more clear:

add <- function(x, y) x + y
addOne <- function(x) add(x, 1)
addOne <- Curry(add, y = 1)

One way to implement Curry is as follows:

Curry <- function(FUN,...) { 
  .orig <- list(...)
  function(...) {
    do.call(FUN, c(.orig, list(...)))
  }
}

(You should be able to figure out how this works. See the exercises.)

But implementing it like this prevents arguments from being lazily evaluated, so it has a somewhat more complicated implementation, basically working by building up an anonymous function by hand. You should be able to work out how this works after you've read the computing on the language chapter. curry is implemented in the pryr package.

Curry <- function(FUN, ...) {
  args <- match.call(expand.dots = FALSE)$...
  args$... <- as.name("...")
  
  env <- new.env(parent = parent.frame())
  
  if (is.name(FUN)) {
    fname <- FUN
  } else if (is.character(FUN)) {
    fname <- as.name(FUN)
  } else if (is.function(FUN)){
    fname <- as.name("FUN")
    env$FUN <- FUN
  } else {
    stop("FUN not function or name of function")
  }
  curry_call <- as.call(c(list(fname), args))

  f <- eval(call("function", as.pairlist(alist(... = )), curry_call))
  environment(f) <- env
  f
}

But back to our problem. With the Curry function we can reduce the code a bit:

funs2 <- list(
  sum = Curry(sum, na.rm = TRUE),
  mean = Curry(mean, na.rm = TRUE),
  median = Curry(median, na.rm = TRUE)
)

But if we look closely that will reveal we're just applying the same function to every element in a list, and that's the job of lapply. This drastically reduces the amount of code we need:

funs2 <- lapply(funs, Curry, na.rm = TRUE)

Let's think about a similar, but subtly different case. Let's take a vector of numbers and generate a list of functions corresponding to trimmed means with that amount of trimming. The following code doesn't work because we want the first argument of Curry to be fixed to mean. We could try specifying the argument name because fixed matching overrides positional, but that doesn't work because the name of the function to call in lapply is also FUN. And there's no way to specify we want to call the trim argument.

trims <- seq(0, 0.9, length = 5) 
lapply(trims, Curry, "mean")
lapply(trims, Curry, FUN = "mean")

Instead we could use an anonymous function

funs3 <- lapply(trims, function(t) Curry("mean", trim = t))
lapply(funs3, call_fun, c(1:100, (1:50) * 100))

But that doesn't work because each function gets a promise to evaluate t, and that promise isn't evaluated until all of the functions are run. To make it work you need to manually force the evaluation of t:

funs3 <- lapply(trims, function(t) {force(t); Curry("mean", trim = t)})
lapply(funs3, call_fun, c(1:100, (1:50) * 100))

A simpler solution in this case is to use Map, as described in the last chapter, which works similarly to lapply except that you can supply multiple arguments by both name and position. For this example, it doesn't do a good job of figuring out how to name the functions, but that's easily fixed.

funs3 <- Map(Curry, "mean", trim = trims)
names(funs3) <- trims
lapply(funs3, call_fun, c(1:100, (1:50) * 100))

It's usually better to use lapply because it is more familiar to most R programmers, and it is somewhat simpler and so is slightly faster.

Exercises

Write a compose function that takes a list of function and creates a new function that calls them in order from left to right.

Case study: numerical integration

To conclude this chapter, we will develop a simple numerical integration tool, and along the way, illustrate the use of many properties of first-class functions: we'll use anonymous functions, lists of functions, functions that make closures and functions that take functions as input. Each step is driven by a desire to make our approach more general and to reduce duplication.

We'll start with two very simple approaches: the midpoint and trapezoid rules. Each takes a function we want to integrate, f, and a range to integrate over, from a to b. For this example we'll try to integrate sin x from 0 to pi, because it has a simple answer: 2

midpoint <- function(f, a, b) {
  (b - a) * f((a + b) / 2)
}

trapezoid <- function(f, a, b) {
  (b - a) / 2 * (f(a) + f(b))
}

midpoint(sin, 0, pi)
trapezoid(sin, 0, pi)

Neither of these functions gives a very good approximation, so we'll do what we normally do in calculus: break up the range into smaller pieces and integrate each piece using one of the simple rules. To do that we create two new functions for performing composite integration:

midpoint_composite <- function(f, a, b, n = 10) {
  points <- seq(a, b, length = n + 1)
  h <- (b - a) / n
  
  area <- 0
  for (i in seq_len(n)) {
    area <- area + h * f((points[i] + points[i + 1]) / 2)
  }
  area
}

trapezoid_composite <- function(f, a, b, n = 10) {
  points <- seq(a, b, length = n + 1)
  h <- (b - a) / n
  
  area <- 0
  for (i in seq_len(n)) {
    area <- area + h / 2 * (f(points[i]) + f(points[i + 1]))
  }
  area
}

midpoint_composite(sin, 0, pi, n = 10)
midpoint_composite(sin, 0, pi, n = 100)
trapezoid_composite(sin, 0, pi, n = 10)
trapezoid_composite(sin, 0, pi, n = 100)

mid <- sapply(1:20, function(n) midpoint_composite(sin, 0, pi, n))
trap <- sapply(1:20, function(n) trapezoid_composite(sin, 0, pi, n))
matplot(cbind(mid = mid, trap))

But notice that there's a lot of duplication across midpoint_composite and trapezoid_composite: they are basically the same apart from the internal rule used to integrate over a simple range. Let's extract out a general composite integrate function:

composite <- function(f, a, b, n = 10, rule) {
  points <- seq(a, b, length = n + 1)
  
  area <- 0
  for (i in seq_len(n)) {
    area <- area + rule(f, points[i], points[i + 1])
  }
  
  area
}

midpoint_composite(sin, 0, pi, n = 10)
composite(sin, 0, pi, n = 10, rule = midpoint)
composite(sin, 0, pi, n = 10, rule = trapezoid)

This function now takes two functions as arguments: the function to integrate, and the integration rule to use for simple ranges. We can now add even better rules for integrating small ranges:

simpson <- function(f, a, b) {
  (b - a) / 6 * (f(a) + 4 * f((a + b) / 2) + f(b))
}

boole <- function(f, a, b) {
  pos <- function(i) a + i * (b - a) / 4
  fi <- function(i) f(pos(i))
  
  (b - a) / 90 * 
    (7 * fi(0) + 32 * fi(1) + 12 * fi(2) + 32 * fi(3) + 7 * fi(4))
}

Let's compare these different approaches.

expt1 <- expand.grid(
  n = 5:50, 
  rule = c("midpoint", "trapezoid", "simpson", "boole"), 
  stringsAsFactors = F)

abs_sin <- function(x) abs(sin(x))
run_expt <- function(n, rule) {
  composite(abs_sin, 0, 4 * pi, n = n, rule = match.fun(rule))
}

library(plyr)
res1 <- mdply(expt1, run_expt)

library(ggplot2)
qplot(n, V1, data = res1, colour = rule, geom = "line")

It turns out that the midpoint, trapezoid, Simpson and Boole rules are all examples of a more general family called Newton-Cotes rules. We can take our integration one step further by extracting out this commonality to produce a function that can generate any general Newton-Cotes rule:

# http://en.wikipedia.org/wiki/Newton%E2%80%93Cotes_formulas
newton_cotes <- function(coef, open = FALSE) {
  n <- length(coef) + open
  
  function(f, a, b) {
    pos <- function(i) a + i * (b - a) / n
    points <- pos(seq.int(0, length(coef) - 1))
    
    (b - a) / sum(coef) * sum(f(points) * coef)        
  }
}

trapezoid <- newton_cotes(c(1, 1))
midpoint <- newton_cotes(1, open = T)
simpson <- newton_cotes(c(1, 4, 1))
boole <- newton_cotes(c(7, 32, 12, 32, 7))
milne <- newton_cotes(c(2, -1, 2), open = TRUE)

# Alternatively, make list then use lapply
lapply(values, newton_cotes, closed)
lapply(values, newton_cotes, open, open = TRUE)
lapply(values, do.call, what = "newton_cotes")

expt1 <- expand.grid(n = 5:50, rule = names(rules), stringsAsFactors = F)
run_expt <- function(n, rule) {
  composite(abs_sin, 0, 4 * pi, n = n, rule = rules[[rule]])
}

Mathematically, the next step in improving numerical integration is to move from a grid of evenly spaced points to a grid where the points are closer together near the end of the range.

Summary

Exercises

Read the source code for Filter, Negate, Find and Position. Write a couple of sentences for each describing how they work.
Write an And function that given two logical functions, returns a logical And of all their results. Extend the function to work with any number of logical functions. Write similar Or and Not functions.
Write a general compose function that composes together an arbitrary number of functions. Write it using both recursion and looping.
How does the first version of Curry work?

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Functional programming

Functional programming

Motivation

Anonymous functions

Exercises

Introduction to closures

Function factories

Mutable state

Exercises

Functionals

`sapply` and `vapply`

`Map` (and `mapply`)

Recursively applying a function

Logical predicates

Matrix families

Other types of loops

Exercises

Mathematical functionals

Function operators

Exercises

Lists of functions

Exercises

Case study: numerical integration

Summary

Exercises

Clone this wiki locally

Functional programming

Functional programming

Motivation

Anonymous functions

Exercises

Introduction to closures

Function factories

Mutable state

Exercises

Functionals

sapply and vapply

Map (and mapply)

Recursively applying a function

Logical predicates

Matrix families

Other types of loops

Exercises

Mathematical functionals

Function operators

Exercises

Lists of functions

Exercises

Case study: numerical integration

Summary

Exercises

Clone this wiki locally

`sapply` and `vapply`

`Map` (and `mapply`)