[Rd] List comprehensions for R

[David C. Norris]

Gabor,

Thank you for drawing this previous work to my attention.  I've attached 
below code that extends the list comprehension to include logical 
'guard' expressions, as in

 > leap.years <- .[ x ~ x <- 1900:2100 | (x %% 400 == 0 || x %% 100 != 0 
&& x %% 4 == 0) ]
 > leap.years
 [1] 1904 1908 1912 1916 1920 1924 1928 1932 1936 1940 1944 1948 1952 
1956 1960
[16] 1964 1968 1972 1976 1980 1984 1988 1992 1996 2000 2004 2008 2012 
2016 2020
[31] 2024 2028 2032 2036 2040 2044 2048 2052 2056 2060 2064 2068 2072 
2076 2080
[46] 2084 2088 2092 2096
 >

I wonder, would many (most?) R users be "mathematically-trained 
statisticians first, and programmers second", and therefore find a 
mathematical notation like the list comprehension more natural than less 
declarative programming constructs?  I would be genuinely interested in 
your (and others') thoughts on that question, based on your knowledge of 
the R user community.

Regards,
David

Gabor Grothendieck wrote:
> That seems quite nice.
>
> Note that there has been some related code posted.  See:
> http://tolstoy.newcastle.edu.au/R/help/03b/6406.html
> which discusses some R idioms for list comprehensions.
>
> Also the gsubfn package has some functionality in this direction.  We
> preface any function with fn$ to allow functions in its arguments
> to be specified as formulas.  Its more R-ish than your code and
> applies to more than just list comprehensions while your code is
> more faithful to list comprehensions.
>
>
>>
## Updated to include logical guards in list comprehensions

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

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

comprehend <- function(expr, vars, seqs, guard, comprehension=list()){
  if(length(vars)==0){  # base case of recursion
    if(eval(guard)) 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], guard, 
comprehension)
    }
  }
  comprehension
}

## List comprehensions specified by close approximation to set-builder 
notation:
##
##   { x+y | 0<x<9, 0<y<x, x*y<30 } ---> .[ x+y ~ {x<-0:9; y<-0:x} | 
x*y<30 ]
##
"[.comprehension" <- function(x, f){
  f <- substitute(f)
  ## First, we pluck out the optional guard, if it is present:
  if(is.call(f) && is.call(f[[3]]) && f[[3]][[1]]=='|'){
    guard <- f[[3]][[3]]
    f[[3]] <- f[[3]][[2]]
  } else {
    guard <- TRUE
  }
  ## 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, guard)
  ## Provided the result is rectangular, convert it to a vector or array
  ## TODO: Extend to handle .LC structures more than 2-deep.
  ## TODO: Avoid rectangularizing nested comprehensions along guarded 
dimensions?
  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
}