R help - Apr 2009 - cast function in package reshape

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 ?

Thank you very much.

David

	[[alternative HTML version deleted]]

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/