使用 apply 计算跨多个数据帧的子量表和总分

Question

我想设置两个函数来自动计算跨多个数据帧的子量表和总分，这些数据帧类似于不同时间点的数据集。 我在这里考虑了各种类似的问题，但还没有找到合适的解决方案。

我设法手动进行计算，但是，我正在努力使用 apply 函数自动计算其他 dfs 可用的其他时间点的子量表分数和总分（来自子量表分数） - 我希望lapply是正确的目的。

一些随机数据来证明问题：

set.seed(1)
df1 <- data.frame(matrix(sample(32), ncol = 8))
names(df1) <- paste(rep(c("a", "b"), each = 4), 1:4, sep = "")

set.seed(2)
df2 <- data.frame(matrix(sample(32), ncol = 8))
names(df2) <- paste(rep(c("a", "b"), each = 4), 1:4, sep = "")

为了考虑潜在的 NA 和相应数量的有效数据，子量表和总分的手动计算如下所示。 对于总分的计算，我也参考了rowSums，因为在真实数据中，有两个以上的子量表构成了总分，并且在每个df中子量表的得分是相邻的。

df1$sub1 <- rowSums(subset(df1, select=a1:a4), na.rm = TRUE) * ncol(subset(df1, select=a1:a4)) / 
rowSums(!is.na(subset(df1, select=a1:a4)))

df1$sub2 <- rowSums(subset(df1, select=b1:b4), na.rm = TRUE) * ncol(subset(df1, select=b1:b4)) / 
rowSums(!is.na(subset(df1, select=b1:b4)))

df1$total <- rowSums(subset(df1, select=sub1:sub2))

df1
df2

我尝试迭代多个数据帧的想法如下：

#Set up a list for the dfs 
dflist <- list(df1, df2)

#Define columns for subscale and total score calculation within each df 
subrange <- list(select(dflist, c(a1:a4, b1:b4)))
totalrange <- list(select(dflist, c(sub1, sub2)))

这就是麻烦开始的地方——它返回一个要求选择的请求

#Set up functions for the subscale scores and total scores 
subscalefun <- function() { 
rowSums(subset(dflist, select=subrange), na.rm = TRUE) * ncol(subset(dflist, select= subrange)) / 
rowSums(!is.na(subset(dflist, select= subrange)))
}

totalfun <- function() {
rowSums(subset(dflist, select=totalrange))
}

这些功能只是被认为是一种展示我尝试完成的工作的方法。 我确信还应该包含一个粘贴参数，以便将结果写入相应的 df。

#Using lapply for calculation of subscale and total scores across dfs defined in dflist
lapply (dflist, subscalefun)
lapply (dflist, totalfun)

非常感谢有关如何处理此任务的一些帮助。 也许有人也可以就如何改进函数式编程提出很好的建议（即从教程中经常介绍的简单函数到编写更复杂的自定义函数并为此获得适当的“词汇表”）。

Answer 1

将代码转换为函数对我来说更容易从镜像原始代码开始。 所以你开始的代码是：

DF$sub1 <- rowSums(...)
DF$sub2 <- rowSums(...)
DF$total <- rowSums(...)

您在lapply()的想法上走在正确的轨道上。 我将在lapply()使用匿名函数：

lapply(dflist
       , function(DF) {
         DF$sub1 <- rowSums(subset(DF, select = a1:a4), na.rm = TRUE)
         DF$sub2 <- rowSums(subset(DF, select = b1:b4), na.rm = TRUE)
         DF$total <- rowSums(subset(DF, select=sub1:sub2))

         return(DF)
       } 
       )

[[1]]
  a1 a2 a3 a4 b1 b2 b3 b4 sub1 sub2 total
1  9  6 16 14 31 24 13 21   45   89   134
2 12 25  2  8 15  3 19 22   47   59   106
3 18 29  5 20 28  7  1 30   72   66   138
4 27 17  4 32 11 23 26 10   80   70   150

[[2]]
  a1 a2 a3 a4 b1 b2 b3 b4 sub1 sub2 total
1  6 27 12 16 20 30  3 14   61   67   128
2 22 26 13 28 19 29 17 25   89   90   179
3 18  4 23  8  7  9 31 24   53   71   124
4  5 21 32 15  1  2 10 11   73   24    97

这不会修改任何内容，因此如果您想保存它dflist <- lapply(dflist, ...)则必须执行dflist <- lapply(dflist, ...) 。

这种方法不太好的一件事是，无论您的数据集中有多少字母，我们都必须复制和粘贴a1:a4 。 由于模式是[letter][number] ，我们可以查看数据集中唯一的第一个字符：

starting_letters <- unique(substring(names(df2), 1, 1))
starting_letters
[1] "a" "b"

我们可以循环遍历starting_letters字母向量以使用grep获得与starting_letters字母匹配的列号的小计：

lapply(starting_letters, function(nam) rowSums(df2[, grep(nam, names(df2))], na.rm = T))

[[1]]
[1] 61 89 53 73

[[2]]
[1] 67 90 71 24

我们还可以根据starting_letters字母向量的长度确定将有多少sub# ：

subm_names <- paste0("sub", seq_len(length(starting_letters)))
subm_names
[1] "sub1" "sub2

并将它们放在一起：

lapply(dflist
       , function(DF) {
         start_letters <- unique(substring(names(DF), 1, 1))
         sub_names <- paste0("sub", seq_len(length(start_letters)))
         DF[sub_names] <- lapply(start_letters
                                 , function(let) {
                                   match_names <- grep(let, names(DF))
                                   rowSums(DF[, match_names], na.rm = T) / length(match_names) * rowSums(!is.na(DF[, match_names]))
                                 }
         )
         # DF[sub_names] <- lapply(start_letters
                                # , function(nam) rowSums(DF[, grep(nam, names(DF))], na.rm = T))
         DF$total <- rowSums(DF[sub_names])

         # DF$sub1 <- rowSums(subset(DF, select = a1:a4), na.rm = TRUE)
         # DF$sub2 <- rowSums(subset(DF, select = b1:b4), na.rm = TRUE)
         # DF$total <- rowSums(subset(DF, select=sub1:sub2))
         return(DF)
       } 
       )

这种方法的优点是更具动态性。 如果列表中的一个data.frame只作为a组，它不会出错。 类似地，它将扩展到data.frame具有更多字母分组或数字分组。

Answer 2

这是使用dplyr的解决方案。 这是心理/健康研究中的常见问题。 我假设您的每个数据帧都包含一个 ID 变量（即，每一行都是一个独特的案例）并且每个数据帧代表一个独特的时间点。 如果您有更多的时间点（即 df3、df4）和更多的子尺度（c、d、e），这种方法将起作用，您只需要相应地调整代码。

# generate sample data
df1 <- data.frame(matrix(sample(32), ncol = 8))
names(df1) <- paste(rep(c("a", "b"), each = 4), 1:4, sep = "")

set.seed(2)
df2 <- data.frame(matrix(sample(32), ncol = 8))
names(df2) <- paste(rep(c("a", "b"), each = 4), 1:4, sep = "")

# add id's and timepoint
df1 <- df1 %>% mutate(id=row_number(),time=1)
df2 <- df2 %>% mutate(id=row_number(),time=2)

# gather data, extract subscale name, calculate totals, join to original data
rbind(df1,df2) %>% gather(k,v,-id,-time) %>% 
  mutate(v=ifelse(v>28,NA,v)) %>% # add some NAs
  mutate(scale=sub('([a-z])[0-9]','\\1',k)) %>% 
  group_by(id,time,scale) %>% 
  summarise(sub.total=mean(v,na.rm=1)*n()) %>% 
  spread(scale,sub.total) %>% mutate(total=a+b) %>% 
  left_join(rbind(df1,df2),.) # original data will not show added NA's

  a1 a2 a3 a4 b1 b2 b3 b4 id time        a        b     total
1 10 27 29 24  4 19  6 18  1    1 81.33333 47.00000 128.33333
2 25  2 11 31  1  8 20 15  2    1 50.66667 44.00000  94.66667
3 13 14 22 28  5  7 17 12  3    1 77.00000 41.00000 118.00000
4 26 23 32 16 30  9  3 21  4    1 86.66667 44.00000 130.66667
5  6 27 12 16 20 30  3 14  1    2 61.00000 49.33333 110.33333
6 22 26 13 28 19 29 17 25  2    2 89.00000 81.33333 170.33333
7 18  4 23  8  7  9 31 24  3    2 53.00000 53.33333 106.33333
8  5 21 32 15  1  2 10 11  4    2 54.66667 24.00000  78.66667