如何修改 Sapply 以在其他列中找到平均值答案

【问题标题】：How can I modify Sapply to find the mean in other columns如何修改 Sapply 以在其他列中找到平均值
【发布时间】：2021-11-18 04:17:56
【问题描述】：

对于每个 Vx（V1...V2 等）列，如果 V1 = 0，我正在尝试提取 Yi0 数据的平均值，如果 V1=1，则 Yi1 数据的平均值，但我的代码似乎有缺陷，有人对我如何解决这个问题有建议吗？

这是我的示例数据和代码

set.seed(1)
    df <- data.frame(Yi0 =  runif(n=10, min = 0, max = 10),
                 Yi1 = runif(n=10, min = 0, max = 10),
                 V1 = c(1,1,1,1,1,0,0,0,0,0),
                 V2 = c(0,1,0,1,0,1,0,1,0,1))

pm <- function(x) {
  as.numeric(
    ifelse(
      test = df[,x] == 0,
      yes =mean(df["Yi0"]),
      no = ifelse(
        test = df[,x] == 1,
        yes = mean(df["Yi1"]),
        no = "error")))
} 

ab <- sapply(X = 3:4, FUN=pm)
ab

最终，我要取 mean(2.059 + 1.765 + ... + 7.69) - mean(8.9838+9.446+...+0.6178)，对于以 V 开头的每一列，我总共有其中有 200 万...

谢谢

这是原始数据集

【问题讨论】：

如果我使用 set.seed 1，我希望取 (2.059746 + 1.765568 + ... 7.698414) 的平均值 - (8.9838+9.4467+...+0.61786) 的平均值 - 59.448
嗨！我已经编辑了帖子，您可以在上面找到它们，非常感谢您

标签： r dataframe loops mean sapply

【解决方案1】：

如果我理解正确的话，对于一栏 (V1) 你想做的事

mean(df$Yi0[df$V1 == 0]) - mean(df$Yi1[df$V1 == 1])
#[1] 1.9

对于使用sapply 的多个列，您可以这样做 -

sapply(df[3:4], function(x) mean(df$Yi0[x == 0]) - mean(df$Yi1[x == 1]))

#   V1    V2 
# 1.94 -0.43

【讨论】：

【解决方案2】：

根据更新后的帖子，我们可以用pivot_longer 重塑为'long'，并在mean 中取差

library(dplyr)
library(tidyr)
df %>% 
    pivot_longer(cols = V1:V2) %>% 
    group_by(name) %>% 
    summarise(Diff = mean(Yi0[value == 0]) - mean(Yi1[value == 1]))

-输出

# A tibble: 2 × 2
  name    Diff
  <chr>  <dbl>
1 V1     1.94 
2 V2    -0.428

如果有很多列，一种有效的方法是使用collapse

library(collapse)
dapply(get_vars(df, vars = "^V\\d+", regex = TRUE), MARGIN = 2,
    FUN = function(x) fmean(df$Yi0[!x] - fmean(df$Yi1[x == 1])))
        V1         V2 
 1.9425275 -0.4277555

【讨论】：

嗨！如果我有 V1 到 V2000000，我还能做同样的事情吗？
@ppotatomato 是的，你仍然可以这样做
@ppotatomato 请检查更新后的答案

【解决方案3】：

除非有人提出data.table 解决方案，否则vapply() 结合pm() 应该是最快的。

pm <- function(x) mean(DF$Yi0[x == 0]) - mean(DF$Yi1[x == 1])
vapply(X=DF[grep('^V', names(DF))], FUN=pm, FUN.VALUE=0)
#        V1         V2 
# 1.9425275 -0.4277555

基准测试：

n <- 1e5 - 2
set.seed(1)
v <- c(1,1,1,1,1,0,0,0,0,0)
DF <- cbind(DF, `colnames<-`(replicate(n, sample(v)), paste0('V', seq(n) + 2)))
microbenchmark::microbenchmark(
  sapply=sapply(DF[-(1:2)], function(x) mean(DF$Yi0[x == 0]) - mean(DF$Yi1[x == 1])),
  vapply=vapply(DF[grep('^V', names(DF))], pm, 0),
  dapply=collapse::dapply(get_vars(DF, vars = "^V\\d+", regex = TRUE), MARGIN = 2,
         FUN = function(x) fmean(DF$Yi0[!x] - fmean(DF$Yi1[x == 1]))),
  times=3L,
  control=list(warmup=10L))
# Unit: seconds
#   expr      min       lq     mean   median       uq      max neval cld
# sapply 1.508540 1.552917 1.568816 1.597293 1.598954 1.600615     3  a 
# vapply 1.432234 1.450200 1.502311 1.468165 1.537350 1.606534     3  a 
# dapply 2.250366 2.257978 2.308068 2.265590 2.336918 2.408247     3   b

【讨论】：