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

Posted 2023-02-22

【中文标题】使用 apply 计算跨多个数据帧的子量表和总分

【英文标题】：Using apply for calculating subscale and total scores across multiple dataframes

【发布时间】：2019-11-29 03:39:16

【问题描述】：

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

我设法手动进行计算，但是，我正在努力使用 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)

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

【参考方案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

我们还可以根据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.frames，具有更多的字母分组或数字分组。

【讨论】：

感谢您的详细解决方案，Cole！使用 DF[sub_names] <- lapply(start_letters... 而不是 DF[sub_names] <- lapply(starting_letters... 您的解决方案就像一个魅力。

我刚刚又看了一下测试手册，上面说项目分数的总和需要乘以相应子量表的项目数，然后将结果除以完成子量表的数量项目。这将如何改变您的解决方案？我想，这可能会改变function(nam) rowSums(DF[, grep(nam, names(DF))], na.rm = T)) 的说法。

我编辑以更正lapply(start_letters...) 并合并您的第二条评论。是的，function(nam) ... 已更改。

是的，这就是工作。伟大的！只是对于那些想知道以前和当前方法之间的区别的人：假设我们有以下子量表项目的值1,2,3,1,2,3,NA。使用na.rm = T 并对项目求和返回总分12。使用更新算法(sum score / divided by the number of valid items * number of items in the subscale) 返回14 分。

【参考方案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

【讨论】：

谢谢你，kstew。你的假设是绝对正确的。这是一个不错的方法，我一定会研究一下，因为我经常使用tidyverse，其中包括dplyr。