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?

The `purrr` package contains another alternative, which doesn't use Reduce or recursion. Since you're learning R, it might provide additional insight for your task: https://github.com/tidyverse/purrr/blob/master/R/compose.R — Artem Sokolov, Sep 23 '18 at 08:02
@Artem Sokolov: That's an interesting implementation - iteration and accumulation into a mutable variable. Kinda the complete opposite of what I asked for (recursive, immutable) like you said, but still very good to see, especially while learning. Thanks for taking the trouble to link it! — Alex Gian, Sep 24 '18 at 10:24

G. Grothendieck · Accepted Answer · 2018-09-23T18:53:43.380

12

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

edited Sep 23 '18 at 18:53

answered Sep 23 '18 at 12:08

G. Grothendieck

254,981
17
203
341

1

I have removed the Note. Looking at it again the problem was that `Recall` was not directly within the top level function but was within the anonymous function defined in the `else` leg. – G. Grothendieck Sep 23 '18 at 17:07
@ G.Grothendieck That's great, thanks, although I think example (1) was the closest to the original code, moreso than (3). I was specifically looking at NOT having to use `of`, which was basically a workaround. Thanks for including example (2) as well, took me a while to wrap my head around it, but helped me to understand exactly what Recall does. Answer accepted as essentially complete. – Alex Gian Sep 24 '18 at 02:49
I think what you mean is that (1) is the closest to what you are looking for. Example (3) is closer to the code presented in the question. It has the same signature and picks the first element and remaining elements out of it, it uses `of` and it uses `do.call` as does the code in the question. – G. Grothendieck Sep 24 '18 at 10:49

Matt Motoki · Answer 2 · 2018-09-23T07:09:57.650

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

egnha · Answer 3 · 2018-09-24T14:40:23.007

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

score 0 · Answer 4 · answered Sep 23 '18 at 19:49

Here is a solution that returns a function which is easy to understand

func <- function(f, ...){
  cl <- match.call()
  if(length(cl) == 2L)
    return(eval(bquote(function(...) .(cl[[2L]]))))

  le <- max(which(sapply(cl, inherits, "name")))
  if(le == length(cl)){
    tmp <- cl[le]
    tmp[[2L]] <- quote(...)
    cl[[length(cl)]] <- tmp

  } else if(le == length(cl) - 1L){
    tmp <- cl[le]
    tmp[[2L]] <- cl[[le + 1L]]
    cl[[le]] <- tmp
    cl[[le + 1L]] <- NULL

  } else
    stop("something is wrong...")

  eval(cl)
}

func(sin, cos, tan) # clear what the function does
#R function (...) 
#R sin(cos(tan(...)))
#R <environment: 0x000000001a189778>
func(sin, cos, tan)(pi/4) # gives correct value
#R [1] 0.5143953

One may have to adjust the sapply(cl, inherits, "name") line to something more general...

moodymudskipper · Answer 5 · 2018-09-24T23:11:29.530

Here is a solution that builds the function from calls, it gives a readable output similar to Benjamin's :

compose_explicit <- function(...){
  funs <- as.character(match.call()[-1])
  body <- Reduce(function(x,y) call(y,x), rev(funs), init = quote(x))
  eval.parent(call("function",as.pairlist(alist(x=)),body))
}
compose_explicit(sin, cos, tan)
# function (x) 
# sin(cos(tan(x)))

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

It seems quite robust:

compose_explicit()
# function (x) 
# x

compose_explicit(sin)
# function (x) 
# sin(x)

And unrelated but useful, here is the code of purrr:compose :

#' Compose multiple functions
#'
#' @param ... n functions to apply in order from right to left.
#' @return A function
#' @export
#' @examples
#' not_null <- compose(`!`, is.null)
#' not_null(4)
#' not_null(NULL)
#'
#' add1 <- function(x) x + 1
#' compose(add1, add1)(8)
compose <- function(...) {
  fs <- lapply(list(...), match.fun)
  n <- length(fs)

  last <- fs[[n]]
  rest <- fs[-n]

  function(...) {
    out <- last(...)
    for (f in rev(rest)) {
      out <- f(out)
    }
    out
  }
}

How can I write a recursive compose function in R?

5 Answers5