Question

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

我设法手动进行了计算，但是，我正在努力使用apply函数自动计算其他df提供的其他时间点的子量表分数和总分数（来自子量表分数）-我希望{{1} }是用于此目的的正确方法。

一些随机数据证明了这个问题：

lapply

要考虑潜在的NA和有效数据的变化对应数量，子量表和总分的手动计算如下所示。在计算总分数时，我还指的是rowSums，因为在实际数据中，有两个以上的子量表构成总分，并且每个df中的子量表分数彼此相邻。

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 = "")

关于尝试遍历多个数据帧的想法如下：

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)))

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

#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))
}

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

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。

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

使用Apply来计算多个数据框的子量表和总分

2 个答案: