How can I write a recursive compose function in R?

Question

I would like to create a function, "compose" in R which will compose an arbitrary number of functions given as arguments.

So far, I have accomplished this by defining a function "of" that composes two arguments and then Reducing this:

of <- function(f,g) function(x) f(g(x))
id <- function(x) x

compose <- function(...) {
  argms = c(...)
  Reduce(of,argms,id)
}

This seems to work fine, but since I'm learning R, I thought I'd try to write it in an explicit recursive style, i.e. forgoing the use of Reduce, iow the sort of thing that you would do in Scheme like this:

(define (compose . args)
  (if (null? args) identity
      ((car args) (apply compose (cdr args)))))

I have come up against a number of obstacles, the major one at the moment seems to be that the first element of the arguments is not getting recognized as a function. My weak attempt so far:

comp <- function(...) {
  argms <- list(...)
  len <- length(argms)
  if(len==0) { return(id) }
  else {
    (argms[1])(do.call(comp,argms[2:len])) 
  }
}

Spits out: Error in comp(sin, cos, tan) : attempt to apply non-function

There must be some way to do this which eludes me. Any suggestions?

Answer 1

1) Try this:

comp1 <- function(f, ...) {
  if (missing(f)) identity
  else function(x) f(comp1(...)(x))
}


# test

comp1(sin, cos, tan)(pi/4)
## [1] 0.5143953

# compose is defined in the question
compose(sin, cos, tan)(pi/4)
## [1] 0.5143953

functional::Compose(tan, cos, sin)(pi/4)
## [1] 0.5143953

sin(cos(tan(pi/4)))
## [1] 0.5143953

library(magrittr)
(pi/4) %>% tan %>% cos %>% sin
## [1] 0.5143953

(. %>% tan %>% cos %>% sin)(pi/4)
## [1] 0.5143953

1a) A variation of (1) which uses Recall is:

comp1a <- function(f, ...) {
  if (missing(f)) identity
  else {
    fun <- Recall(...)
    function(x) f(fun(x))
  }
}

comp1a(sin, cos, tan)(pi/4)
## [1] 0.5143953

2) Here is another implementation:

comp2 <- function(f, g, ...) {
  if (missing(f)) identity
  else if (missing(g)) f
  else Recall(function(x) f(g(x)), ...)
}

comp2(sin, cos, tan)(pi/4)
## [1] 0.5143953

3) This implementation is closer to the code in the question. It makes use of of defined in the question:

comp3 <- function(...) {
  if(...length() == 0) identity
  else of(..1, do.call("comp3", list(...)[-1]))
}
comp3(sin, cos, tan)(pi/4)
## [1] 0.5143953

Answer 2

An alternative to rolling your own function composition is to use the gestalt package, which provides composition both as a higher-order function, compose(), and as an infix operator, %>>>%. (For these to read the same, functions are composed from left to right.)

Basic usage is straightforward:

library(gestalt)

f <- compose(tan, cos, sin)  # apply tan, then cos, then sin
f(pi/4)
#> [1] 0.514395258524

g <- tan %>>>% cos %>>>% sin
g(pi/4)
#> [1] 0.514395258524

But you get a lot of additional flexibility:

## You can annotate composite functions and apply list methods
f <- first: tan %>>>% cos %>>>% sin
f[[1]](pi/4)
#> [1] 1
f$first(pi/4)
#> [1] 1

## magrittr %>% semantics, such as implicity currying, is supported
scramble <- sample %>>>% paste(collapse = "")
set.seed(1); scramble(letters, 5)
#> [1] "gjnue"

## Compositions are list-like; you can inspect them using higher-order functions
stepwise <- lapply(`%>>>%`, print) %>>>% compose
stepwise(f)(pi/4)
#> [1] 1
#> [1] 0.540302305868
#> [1] 0.514395258524

## formals are preserved
identical(formals(scramble), formals(sample))
#> [1] TRUE

One thing you should keep in mind about function calls in R is that their cost is not negligible. Unlike doing literal function composition, compose() (and %>>>%) flatten compositions when called. In particular, the following invocations produce the same function, operationally:

fs <- list(tan, cos, sin)

## compose(tan, cos, sin)
Reduce(compose, fs)
Reduce(`%>>>%`, fs)
compose(fs)
compose(!!!fs)  # tidyverse unquote-splicing

Answer 3

One problem is that if len==1, then argms[2:len] returns a list of length 2; in particular,

> identical(argms[2:1], list(NULL, argms[[1]]))
[1] TRUE

To fix that you could just drop the first element of the list using argms[-1].

You also need to make use of your of function because as probably you noted sin(cos) returns an error rather than a function. Putting this together we get:

comp <- function(...) {
  argms <- c(...)
  len <- length(argms)
  if(len==1) { return(of(argms[[1]], id)) }
  else {
    of(argms[[1]], comp(argms[-1]))
  }
}

> comp(sin, cos, tan)(1)
[1] 0.0133878
> compose(sin, cos, tan)(1)
[1] 0.0133878