R函数用于绘制分箱装置和模型拟合,ggplot

时间:2013-01-31 14:50:20

标签: r ggplot2 data.table

示例数据:

    pp.inc <- structure(list(has.di.rec.pp = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0), m.dist.km2 = c(-34.4150009155273, 6.80600023269653, -6.55499982833862, 
-61.7700004577637, 15.6840000152588, -11.2869997024536, -26.9729995727539, 
0, 81.9940032958984, -35.1459999084473, -12.5179996490479, 0, 
21.5919990539551, 81.9940032958984, -20.7770004272461, 85.9469985961914, 
-15.2959995269775, -75.5879974365234, 81.9940032958984, 3.04999995231628, 
-17.1490001678467, -25.806999206543, -16.0060005187988, -14.91100025177, 
-12.9020004272461, -16.0060005187988, 5.44000005722046, -34.4150009155273, 
81.9940032958984, 3.61400008201599, 13.7379999160767, 2.71300005912781, 
4.31300020217896), treated = c(0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 
0, 1, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 
1, 1)), .Names = c("has.di.rec.pp", "m.dist.km2", "treated"), row.names = c(NA, 
-33L), class = c("data.table", "data.frame"))

代码:

library(data.table)
library(ggplot2)

rddplot <- function(data, outcome, runvar, treatment = treated, span, bw, ...){
    data <- data.table(data)
    data.span  <- data[abs(runvar) <= span, ]
    data.span <- data.span[ , bins := cut(runvar, 
                                          seq(-span, span, by = bw), 
                                          include.lowest = TRUE, right = FALSE)]
    data.span.plot <- data.span[ , list(avg.outcome = mean(outcome), 
                                      avg.runvar = mean(runvar), 
                                      treated = max(treatment),
                                      n.iid = length(outcome)), keyby = bins]
    data.span.plot <- data.span.plot[ , runvar := head(seq(-span, span, by = bw), -1)]
    bp <- ggplot(data = data.span.plot, aes(x = runvar, y = avg.outcome))
    bp <- bp + geom_point(aes(colour = n.iid))
    bp <- bp + stat_smooth(data = data.span, aes(x = runvar, y = outcome,
                                                group = factor(treatment)), ...)
    bp
    return(bp)
}

rddplot(pp.inc, has.di.rec.pp, m.dist.km2, treated, 50, 5)

如果我不将它包装在函数中,则此代码运行完美。我是R的新手,很少使用它。我究竟做错了什么?我错过了一些明显的或与data.tableggplot2有关的内容吗?我认为它可能与ggplot有关,因为其他问题提到存在问题并且应该使用aes_string。我可以重写data.table部分以使用基本功能。但我认为错误已经发生在第二行之前。我如何使这项工作?

编辑:

[原标题: R函数返回eval中的错误(expr,envir,enclos):找不到对象'名称'

我有时间再次看一下这个并找到了解决方案,因此我也对标题进行了修改。使用eval()对我来说并不是很有效,所以我选择了[['columname']]选择路线。我已经放弃了data.table(以及plyr),因此除了ggplot2之外,它只使用base个函数。我很高兴有关如何改进它的任何意见。如果存在一些重要缺陷,请告诉我。如果不是,我稍后会在我的解决方案中添加答案。

我已经更改了bin计算,因此总是有一个断点为零,这是必要的。默认binwidth由Silverman规则确定。我正在考虑单独计算模型拟合并返回它,因为ggplot中的模型选择是有限的,但是我想不出一个很好的方法将它合并到各种不同的模型,如lm或loess,并且它不是严格的必要。我实际上想要覆盖一个显示每个bin中观察数量的细条形图,但是在ggplot中发现这是不可能的(我知道这个一般是一个坏主意,但是有几个很好发表使用类似图表的论文)。我没有找到size aestetic来吸引这里,但这些都是轻微的抱怨。

感谢您让我走上正确的道路。

我的解决方案:

rddplot <- function(data, outcome, runvar, treatment = treated, 
                    span, bw = bw.nrd0(data[[runvar]]), ...){
    breaks <- c(sort(-seq(0, span, by = bw)[-1]), seq(0, span, by = bw))
    data.span  <- data[abs(data[[runvar]]) <= max(breaks), ]
    data.span$bins <- cut(data.span[[runvar]], breaks, 
                          include.lowest = TRUE, right = FALSE)
    data.span.plot <- as.data.frame(cbind(tapply(data.span[[outcome]], data.span$bins, mean),
                            tapply(data.span[[runvar]], data.span$bins, mean),
                            tapply(data.span[[treatment]], data.span$bins, max),
                            tapply(data.span[[outcome]], data.span$bins, length),
                            tapply(data.span[[outcome]], data.span$bins, sum)))
    colnames(data.span.plot) <- c("avg.outcome", "avg.runvar", "treated", "n.iid", "n.rec")
    data.span.plot$runvar <- head(breaks, -1)
    print(data.span.plot)
    bp <- ggplot(data = data.span.plot, aes(x = runvar, y = avg.outcome))
    bp <- bp + geom_point(aes(size = n.iid))
    bp <- bp + stat_smooth(data = data.span, aes_string(x = runvar, y = outcome,
                                                group = treatment), ...)
    print(bp)
}

呼叫:

rddplot(pp.inc, "has.di.rec.pp", "m.dist.km2", "treated", 50, 
        method = lm, formula = y ~ poly(x, 4, raw = TRUE))

1 个答案:

答案 0 :(得分:2)

我有一种使用data.table和一些deparse(substitute())setnames技巧的方法......

rddplot <- function(data, outcome, runvar, treatment = treated, span, bw, ...){
 # convert to data.table 
 data <- data.table(data)
 # get the column names as defined in the call to rddplot 
  outname <- deparse(substitute(outcome))
  runname <- deparse(substitute(runvar))
  treatname <- deparse(substitute(treatment))
 # rename these columns with the argument namses
  setnames(data, old = c(outname,runname,treatname), new = c('outcome','runvar', 'treatment'))

  # breaks as defined in the second example
  breaks <- c(sort(-seq(0, span, by = bw)[-1]), seq(0, span, by = bw))
   # the stuff you were doing before
   data.span  <- data[abs(runvar) <= span, ]
  data.span <- data.span[ , bins := cut(runvar, 
                                        breaks, 
                                        include.lowest = TRUE, right = FALSE)]
  data.span.plot <- data.span[ , list(avg.outcome = mean(outcome), 
                                      avg.runvar = mean(runvar), 
                                      treated = max(treatment),
                                      n.iid = length(outcome)), keyby = bins]
  # note I've removed trying to add `runvar` column to data.span.plot....)
  bp <- ggplot(data = data.span.plot, aes(x = avg.runvar, y = avg.outcome))
  bp <- bp + geom_point(aes(colour = n.iid))
  bp <- bp + stat_smooth(data = data.span, aes(x = runvar, y = outcome,
                                               group = treatment), ...)
  bp

}



rddplot(pp.inc, has.di.rec.pp, m.dist.km2, treated, 50, 5)

注意,如果你没有在函数中转换为data.table,并假设data参数是data.table,那么你可以使用on.exit()来恢复通过引用更改的名称。