如何重写此代码以便按预期使用plyr / ddply?

时间:2010-12-09 22:00:53

标签: r refactoring plyr

背景

我有一个概率分布的数据框,我想计算以下的统计摘要:

priors <- structure(list(name = c("theta1", "theta2", "theta3", "theta4", 
  "theta5"), distn = c("gamma", "beta", "lnorm", "weibull", "gamma"), 
   parama = c(2.68, 4, 1.35, 1.7, 2.3), paramb = c(0.084, 7.2, 0.69, 0.66, 3.9),
   another_col = structure(c(3L, 4L, 5L, 1L, 2L
   ), .Label = c("1", "2", "a", "b", "c"), class = "factor")), 
   .Names = c("name", "distn", "parama", "paramb", "another_col"), row.names = c("1",
   "2", "3", "4", "5"), class = "data.frame")

方法

第1步:我写了一个函数来计算摘要并返回mean(lcl, ucl)

 summary.stats <- function(distn, A, B) {
  if (distn == 'gamma'  ) ans <- c(A*B,                       qgamma(c(0.05, 0.95), A[ ], B))
  if (distn == 'lnorm'  ) ans <- c(exp(A + 1/2 * B^2),        qlnorm(c(0.05, 0.95), A, B))
  if (distn == 'beta'   ) ans <- c(A/(A+B),                   qbeta( c(0.05, 0.95), A, B))
  if (distn == 'weibull') ans <- c(mean(rweibull(10000,A,B)), qweibull(c(0.05, 0.95), A, B))
  if (distn == 'norm'   ) ans <- c(A,                         qnorm( c(0.05, 0.95), A, B))
  ans <- (signif(ans, 2))
  return(paste(ans[1], ' (', ans[2], ', ', ans[3],')', sep = ''))
}

第2步:我想在我的数据框中添加一个名为stats

的新列
priors$stats <- ddply(priors, 
                     .(name, distn, parama, paramb), 
                     function(x)  summary.stats(x$distn, x$parama, x$paramb))$V1

问题1:

这样做的正确方法是什么?我尝试

时出错
                ddply(priors, 
                     .(name, distn, parama, paramb),
                     transform, 
                     stats = function(x)  summary.stats(x$distn, x$parama, x$paramb))

问题2:(额外信用)

是否有更有效的方法对summary.stats函数进行编码,即使用较少的'if'是?

更新

感谢Shane和Joshua为我清理这件事。

我还发现了一个问题,对于试图do a plyr operation on every row of a dataframe

的其他人有帮助

2 个答案:

答案 0 :(得分:4)

以下是使用summary.stats的{​​{1}}的已清理版本。我还在输出中添加了名称“stats”,因为这似乎是绊倒你的事情。

switch

我不确定如何使用summaryStats <- function(distn, A, B) { CI <- c(0.05, 0.95) FUN <- get(paste("q",distn,sep="")) ans <- switch(distn, gamma = A*B, lnorm = exp(A + 1/2 * B^2), beta = A/(A+B), weibull = mean(rweibull(10000,A,B)), norm = A) ans <- c(ans, FUN(CI, A, B)) ans <- (signif(ans, 2)) out <- c(stats=paste(ans[1], ' (', ans[2], ', ', ans[3],')', sep='')) return(out) } 执行此操作,但您可以使用这样的无聊plyr来执行此操作:

sapply

答案 1 :(得分:4)

我可能会遗漏一些东西,但是使用Josh的功能和你的数据,这很好。

priors <- ddply(priors, 
  .(name, distn, parama, paramb), 
  function(x)  summaryStats(x$distn, x$parama, x$paramb))
colnames(priors)[5] <- "stats"

您希望输出看起来像什么?

> priors
    name   distn parama paramb            stats
1 theta1   gamma   2.68  0.084   0.23 (7.8, 69)
2 theta2    beta   4.00  7.200 0.36 (0.15, 0.6)
3 theta3   lnorm   1.35  0.690    4.9 (1.2, 12)
4 theta4 weibull   1.70  0.660 0.59 (0.12, 1.3)
5 theta5   gamma   2.30  3.900    9 (0.12, 1.3)

修改

对不起,没看完你的评论。然后这应该工作(在我的例子中,我留下一列):

ddply(priors, .(distn, parama, paramb), function(x) 
   data.frame(x, stats=summaryStats(x$distn, x$parama, x$paramb)))