r - 使用 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, ...)如果您想保存它。

这种方法的一个缺点是我们必须复制并粘贴 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

我们还可以确定有多少 sub#将基于 starting_letters 的长度矢量:

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有更多的字母分组或数字分组。