在一个因子上拆分数据框并应用一个函数

Question

在 R 中，我想沿因子变量拆分数据框，然后将函数应用于与该变量的每个级别相关的数据。我想在我的函数中完成所有这些。不知何故，数据没有被拆分？

我不明白将参数传递给嵌套在其他函数中的函数的所有细微差别。我最初尝试使用 dplyr 执行此操作，但无法将参数传递给嵌套在我的函数中的 dplyr。

这是我的功能：

 myFun <- function(dat, strat.var, PSU, var1){
     strata <- as.character(unique(dat[, strat.var]))
     N.h <- length(strata)
     sdat <- with(dat, split(dat, strat.var))
     fun1 <- function(x){ length(unique(x[, PSU])) }
     fun2  <- function(x){ sum(tapply(x[, var1], x[, PSU],  mean)) }
     ns <- sapply(sdat, fun1)
     mns <- sapply(sdat, fun2)
     dfx <- data.frame(cbind(stratum=strata, ns=ns, mns=mns))
     return(list(N.h = N.h, out=dfx))
 }

为了证明我使用了 warpbreaks 数据，但我的实际数据集有 8 个级别的“strat.var”，并且嵌套在 2 到 10 个级别的“PSU”之间。

    myFun(dat=warpbreaks, strat.var="wool", PSU="tension", var1="breaks")
   # $N.h
   # [1] 2

   # $out
   #   stratum ns              mns
   # 1       A  3 84.4444444444444
   # 2       B  3 84.4444444444444

但这是不正确的，因为我用手做：

 sdat <- with(warpbreaks, split(warpbreaks, wool))
 fun1 <- function(x, PSU){ length(unique(x[, PSU])) }
 fun2 <- function(x, PSU, var1){ sum(tapply(x[, var1], x[, PSU], mean)) }
 sapply(sdat, fun1, PSU="tension") 
# A B 
# 3 3 
 sapply(sdat, fun2, PSU="tension", var1="breaks") 
#       A        B 
# 93.11111 75.77778

我使用sapply() 是因为this one 和this one 之类的帖子。而且我没有使用subset()，因为我无法让它工作。我也愿意接受任何使用 dplyr() 的建议。

提前感谢您的任何帮助！

Answer 1

你可以替换

 sdat <- with(dat, split(dat, strat.var))

与

sdat <- split(dat, dat[strat.var])

在myFun。

之前的代码不是预期的splitting，而是您获得整个数据的sum，即

sum(with(warpbreaks, tapply(breaks, tension, FUN=mean)))
#[1] 84.44444

使用更正后的myFun

myFun(warpbreaks, strat.var='wool', PSU='tension', var1='breaks')
#$N.h
#[1] 2

#$out
#  stratum ns              mns
#A       A  3 93.1111111111111
#B       B  3 75.7777777777778

你也可以使用dplyr创建一个函数（你可以微调下面的）

library(lazyeval)
library(dplyr)
myFun2 <- function(dat, strat.var, PSU, var1) {
   dat %>%
      mutate_(N.h = interp(~n_distinct(var),
               var = as.name(strat.var))) %>% 
      group_by_(.dots=strat.var) %>%
      mutate_(ns = interp(~n_distinct(var), var=as.name(PSU))) %>% 
      group_by_(.dots=PSU, add=TRUE) %>% 
      mutate_(mns=interp(~mean(var), var=as.name(var1))) %>%  
      select_(.dots= list(strat.var, 'ns', 'N.h', 'mns')) %>%
      unique() %>%
      group_by_(.dots=strat.var, 'ns', 'N.h') %>% 
      summarise(mns=sum(mns))                  
 }

myFun2(warpbreaks, 'wool', 'tension', 'breaks')
#Source: local data frame [2 x 4]
#Groups: ns, N.h

#  ns N.h wool      mns
#1  3   2    A 93.11111
#2  3   2    B 75.77778