List comprehensions for R

library(gsubfn)
fn$sapply(0:11/11, ~ sin(x))

fn$sapply(0:4, y ~ fn$sapply(0:3, x ~ x*y))

fn$sapply(0:4, y ~ fn$sapply(0:y, x ~ x*y))

unlist(fn$sapply(1:4, y ~ fn$sapply(1:y, x ~ x*y)))

Below is code that introduces a list comprehension syntax into R,
allowing expressions like:

 > .[ sin(x) ~ x <- (0:11)/11 ]

 [1] 0.00000000 0.09078392 0.18081808 0.26935891 0.35567516 0.43905397
 [7] 0.51880673 0.59427479 0.66483486 0.72990422 0.78894546 0.84147098

 > .[ .[x*y ~ x <- 0:3] ~ y <- 0:4]

    [,1] [,2] [,3] [,4] [,5]
[1,]    0    0    0    0    0
[2,]    0    1    2    3    4
[3,]    0    2    4    6    8
[4,]    0    3    6    9   12

 > .[ .[x+y ~ x <- 0:y] ~ y <- 0:4]

[[1]]
[1] 0

[[2]]
[1] 1 2

[[3]]
[1] 2 3 4

[[4]]
[1] 3 4 5 6

[[5]]
[1] 4 5 6 7 8

 > .[ x*y ~ {x <- 1:4; y<-1:x} ]

 [1]  1  2  4  3  6  9  4  8 12 16

These constructions are supported by the following code.

Regards,
David

##
## Define syntax for list/vector/array comprehensions
##

. <<- structure(NA, class="comprehension")

comprehend <- function(expr, vars, seqs, comprehension=list()){
 if(length(vars)==0) # base case
   comprehension[[length(comprehension)+1]] <- eval(expr)
 else
   for(elt in eval(seqs[[1]])){
     assign(vars[1], elt, inherits=TRUE)
     comprehension <- comprehend(expr, vars[-1], seqs[-1], comprehension)
   }
 comprehension
}

## Support general syntax like .[{exprs} ~ {generators}]
"[.comprehension" <- function(x, f){
 f <- substitute(f)
 ## To allow omission of braces around a lone comprehension generator,
 ## as in 'expr ~ var <- seq' we make allowances for two shapes of f:
 ##
 ## (1)    (`<-` (`~` expr
 ##                   var)
 ##              seq)
 ## and
 ##
 ## (2)    (`~` expr
 ##             (`{` (`<-` var1 seq1)
 ##                  (`<-` var2 seq2)
 ##                      ...
 ##                  (`<-` varN <- seqN)))
 ##
 ## In the former case, we set gens <- list(var <- seq), unifying the
 ## treatment of both shapes under the latter, more general one.
 syntax.error <- "Comprehension expects 'expr ~ {x1 <- seq1; ... ; xN
<- seqN}'."
 if(!is.call(f) || (f[[1]]!='<-' && f[[1]]!='~'))
   stop(syntax.error)
 if(is(f,'<-')){ # (1)
   lhs <- f[[2]]
   if(!is.call(lhs) || lhs[[1]] != '~')
     stop(syntax.error)
   expr <- lhs[[2]]
   var <- as.character(lhs[[3]])
   seq <- f[[3]]
   gens <- list(call('<-', var, seq))
 } else { # (2)
   expr <- f[[2]]
   gens <- as.list(f[[3]])[-1]
   if(any(lapply(gens, class) != '<-'))
     stop(syntax.error)
 }
 ## Fill list comprehension .LC
 vars <- as.character(lapply(gens, function(g) g[[2]]))
 seqs <- lapply(gens, function(g) g[[3]])
 .LC <- comprehend(expr, vars, seqs)
 ## Provided the result is rectangular, convert it to a vector or array
 ## TODO: Extend to handle .LC structures more than 2-deep.
 if(!length(.LC))
   return(.LC)
 dim1 <- dim(.LC[[1]])
 if(is.null(dim1)){
   lengths <- sapply(.LC, length)
   if(all(lengths == lengths[1])){ # rectangular
     .LC <- unlist(.LC)
     if(lengths[1] > 1) # matrix
       dim(.LC) <- c(lengths[1], length(lengths))
   } else { # ragged
     # leave .LC as a list
   }
 } else { # elements of .LC have dimension
   dim <- c(dim1, length(.LC))
   .LC <- unlist(.LC)
   dim(.LC) <- dim
 }
 .LC
}