[R] cast function in package reshape

[hadley wickham]

On Fri, Apr 17, 2009 at 8:38 AM, David Hajage <dhajage.r at gmail.com> wrote:
> Hello R useRs,
>
> I have a function which returns a list of functions :
>
> freq1 <- function(x) {
>  lev <- unique(x[!is.na(x)])
>  nlev <- length(lev)
>  args <- alist(x=)
>
>  if (nlev == 1) {
>    body <- c("{", "sum(!is.na(x))", "}")
>    f <- function() {}
>    formals(f) <- as.pairlist(args)
>    body(f) <- parse(text = body)
>    namef <- paste("freq", as.character(nlev), sep = "_")
>    assign(namef, f)
>    res <- list(get(namef))
>    names(res) <- namef
>  }
>  if (nlev > 1) {
>    res <- NULL
>    namesf <- NULL
>    for (i in 1:nlev) {
>      body <- c("{", paste("sum(x[!is.na(x)] ==", as.character(lev[i]), ")",
> sep = " "), "}")
>      f <- function() {}
>      formals(f) <- as.pairlist(args)
>      body(f) <- parse(text = body)
>      namef <- paste("freq", as.character(lev[i]), sep = "_")
>      assign(namef, f)
>      namesf <- c(namesf, namef)
>      res <- c(res, get(namef))
>    }
>    names(res) <- namesf
>  }
>  return(res)
> }
>
> df <- data.frame(id = 1:50, x = sample(c(NA, 1), 50, T), y = sample(1:2, 50,
> T), z = sample(letters[1:2], 50, T))
>
>> freq1(df$x)
> $freq_1
> function (x)
> {
>    sum(!is.na(x))
> }
> <environment: 0x03d99684>
>
>> freq1(df$y)
> $freq_2
> function (x)
> {
>    sum(x[!is.na(x)] == 2)
> }
> <environment: 0x03d6c930>
>
> $freq_1
> function (x)
> {
>    sum(x[!is.na(x)] == 1)
> }
> <environment: 0x03d6c930>
>
>
> I would like to use this list of functions with cast function (in package
> reshape by Hadley Wickham) :
>
>> cast(melt(df, id = c("id", "z"), measure = c("x", "y")), variable +
> result_variable ~ z, fun = function(x) freq1(x), margins = "grand_col")
> Erreur dans freq1(x) : objet "res" non trouvé
>
> Here the result I would like to have :
>
>  variable                  a  b (all)
> 1        x          freq_1 10 14    24
> 2        y          freq_1 18 32    50
> 3        y          freq_2  9 14    23
>
> I admit it is a bit far-fetched, but is this actually possible ?

Something like this?

df <- data.frame(
  id = 1:50,
  x = sample(c(NA, 1), 50, T),
  y = sample(1:2, 50, T),
  z = sample(letters[1:2], 50, T)
)
dfm <- melt(df, id = c("id", "z"))


f1 <- function(base)
  function(x) table(factor(x, levels = unique(base)))
cast(dfm, variable + result_variable ~ z, f1(dfm$value),
  margins = "grand_col")

I think f1 effectively does what your freq1 function does, but always
returns the same number of results, a requirement of the aggregation
function in cast.

Hadley

-- 
http://had.co.nz/