[Rd] List comprehensions for R

From: David C. Norris <david_at_unusualsolutionsthatwork.com>
Date: Sun, 09 Dec 2007 13:41:46 -0800


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
}

R-devel_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Sun 09 Dec 2007 - 21:48:42 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Mon 10 Dec 2007 - 09:30:44 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.