logo标签列表

在R中加快矩阵列的操作速度

rfor-loopdplyr
4

我的数据集看起来像下面这个 R 数据集

dat <- data.frame(z = seq(0.5, 1,0.1), matrix(1:24, nrow = 6) )
colnames(dat) <- c("z", "A", "B", "C", "D")
dat
#   z  A  B  C  D
#  0.5 1  7 13 19
#  0.6 2  8 14 20
#  0.7 3  9 15 21
#  0.8 4 10 16 22
#  0.9 5 11 17 23
#  1.0 6 12 18 24

我想对列 A，B，C 和 D 每个输入执行相同的操作，因此我需要在 dat 中添加另一列，在这一列中，对于每个这些列中的每行中剩余三列的条目求和，将其除以行条目的标准偏差，再乘以列 z 中相应行值的比率。例如，取列 A 中的第一个条目。该操作为 0.5 * (7 + 13 + 19) / sd(c(7, 13, 19))。对于列 B 中的第二个条目，它应为 0.6 * (2 + 14 + 20) / sd(c(2, 14, 20))。这些操作生成一个 6 x 4 矩阵，我需要将其附加到 dat。
我的数据集非常庞大（而且我希望能够快速地启动它），因此我想知道最快的方法是什么。使用 for 循环相当慢（而且会使引导程序变得更糟）。我正在考虑使用 dplyr 包，但我不太熟悉。谢谢。
5个回答
4

我不确定你是否可以避免双重循环结构，特别是当你必须对每个元素执行此操作时，但有一种方法可以做到这一点。

dat[paste0("operation", letters[1:4])] <-  t(apply(dat, 1, function(x) 
 sapply(x[-1], function(y) x[1] * sum(setdiff(x[-1], y))/sd(setdiff(x[-1], y)))))


dat
#    z A  B  C  D operationa operationb operationc operationd
#1 0.5 1  7 13 19       3.25   1.800298   1.472971       1.75
#2 0.6 2  8 14 20       4.20   2.356753   1.963961       2.40
#3 0.7 3  9 15 21       5.25   2.978674   2.520417       3.15
#4 0.8 4 10 16 22       6.40   3.666061   3.142338       4.00
#5 0.9 5 11 17 23       7.65   4.418912   3.829724       4.95
#6 1.0 6 12 18 24       9.00   5.237229   4.582576       6.00

首先，我们遍历每一行，然后对于该行中的每个元素，我们依次排除一个元素并计算剩余元素的sum和sd，然后将其乘以该行中的第一个元素。我们将这个新矩阵作为原始数据框的新列附加上去。

4

看这里！一些复杂的data.table代码:

library(data.table)
setDT(dat)
dat[, row := .I]
mdat <- melt(dat, id.vars=c("row","z"))
dcast(mdat[,
     mdat[.BY[1], on="row"][!.BY[2], on="variable", sum(value)/sd(value)*z[1], by=row],
     by=.(row,variable)
     ][,-1], row ~ variable, value.var="V1")

#   row    A        B        C    D
#1:   1 3.25 1.800298 1.472971 1.75
#2:   2 4.20 2.356753 1.963961 2.40
#3:   3 5.25 2.978674 2.520417 3.15
#4:   4 6.40 3.666061 3.142338 4.00
#5:   5 7.65 4.418912 3.829724 4.95
#6:   6 9.00 5.237229 4.582576 6.00
1
dat2 <- cbind(dat, matrix(c(
    dat$z * rowSums(dat[,c("B", "C", "D")]) / apply(dat[,c("B", "C", "D")], 1, function(x) {sd(x)}),
    dat$z * rowSums(dat[,c("A", "C", "D")]) / apply(dat[,c("A", "C", "D")], 1, function(x) {sd(x)}),
    dat$z * rowSums(dat[,c("A", "B", "D")]) / apply(dat[,c("A", "B", "D")], 1, function(x) {sd(x)}),
    dat$z * rowSums(dat[,c("A", "B", "C")]) / apply(dat[,c("A", "B", "C")], 1, function(x) {sd(x)})
    ), ncol = 4, dimnames = list(c(1:6), paste0(LETTERS[1:4], "_operation"))))

    z A  B  C  D A_operation B_operation C_operation D_operation
1 0.5 1  7 13 19        3.25    1.800298    1.472971        1.75
2 0.6 2  8 14 20        4.20    2.356753    1.963961        2.40
3 0.7 3  9 15 21        5.25    2.978674    2.520417        3.15
4 0.8 4 10 16 22        6.40    3.666061    3.142338        4.00
5 0.9 5 11 17 23        7.65    4.418912    3.829724        4.95
6 1.0 6 12 18 24        9.00    5.237229    4.582576        6.00

0.5 * (7 + 13 + 19) / sd(c(7, 13, 19)) == dat2[1,"A_operation"]
[1] TRUE
0.6 * (2 + 14 + 20) / sd(c(2, 14, 20)) == dat2[2,"B_operation"]
[1] TRUE
1
一条 for 循环就足够了：
m=function(x,y){
   l=unlist(dat[y,names(dat)!=x])
   unname(l[1]*sum(l[-1])/sd(l[-1]))
 }
 matrix(mapply(m,names(dat)[-1],t(row(dat[-1]))),nrow(dat),byrow = T)
     [,1]     [,2]     [,3] [,4]
[1,] 3.25 1.800298 1.472971 1.75
[2,] 4.20 2.356753 1.963961 2.40
[3,] 5.25 2.978674 2.520417 3.15
[4,] 6.40 3.666061 3.142338 4.00
[5,] 7.65 4.418912 3.829724 4.95
[6,] 9.00 5.237229 4.582576 6.00

使用tidyverse：
dat%>%
   mutate(i=1:nrow(dat))%>%
   group_by(i)%>%
   gather(key,val,-i)%>%
   summarise(s=list(map_dbl(2:ncol(dat),
       ~val[1]*sum(val[-c(1,.x)])/sd(val[-c(1,.x)]))))%>%
   pull(s)%>%invoke(rbind,.)
     [,1]     [,2]     [,3] [,4]
[1,] 3.25 1.800298 1.472971 1.75
[2,] 4.20 2.356753 1.963961 2.40
[3,] 5.25 2.978674 2.520417 3.15
[4,] 6.40 3.666061 3.142338 4.00
[5,] 7.65 4.418912 3.829724 4.95
[6,] 9.00 5.237229 4.582576 6.00

你还可以做：

sapply(1:4,function(x)dat[,1]*colSums(s<-t(dat[-c(1,x+1)]))/sqrt(diag(var(s))))
     [,1]     [,2]     [,3] [,4]
[1,] 3.25 1.800298 1.472971 1.75
[2,] 4.20 2.356753 1.963961 2.40
[3,] 5.25 2.978674 2.520417 3.15
[4,] 6.40 3.666061 3.142338 4.00
[5,] 7.65 4.418912 3.829724 4.95
[6,] 9.00 5.237229 4.582576 6.00
我接受了这个解决方案，因为tidyverse似乎是最快的方法。谢谢你，也感谢其他所有人的回答。 - Andrew
我认为sapply比tidyverse慢，对吧？我不熟悉tidyverse。你能让我了解一下map_dbl的直觉意义是什么吗（当然它执行操作，但我不知道它是如何完成的）？ - Andrew
你实际上可以在所有这些解决方案上进行微基准测试。这样你就能够确定哪个最快。 - Onyambu
最后一个sapply实际上是最快的，但我需要以不同的方式对数据进行子集操作多次重复相同的操作，因此tidyverse似乎更可取。我需要更好地掌握它的逻辑结构。 - Andrew
1

使用mutate_at的解决方案可以通过在.funs中访问当前列名并将其排除来实现。基本技巧是按row_number进行group_by，以便计算即rowSums和sd发生在每一行。

library(dplyr)

dat %>% group_by(grp = row_number()) %>%
    mutate_at(vars(A:D), 
        funs(New = z*rowSums(dat[grp,!names(dat) %in% c("z",quo_name(quo(.)))])/
              sd(dat[grp,!names(dat) %in% c("z",quo_name(quo(.)))]))) %>%
  ungroup() %>%
  select(-grp) %>% as.data.frame()

#     z A  B  C  D A_New    B_New    C_New D_New
# 1 0.5 1  7 13 19  3.25 1.800298 1.472971  1.75
# 2 0.6 2  8 14 20  4.20 2.356753 1.963961  2.40
# 3 0.7 3  9 15 21  5.25 2.978674 2.520417  3.15
# 4 0.8 4 10 16 22  6.40 3.666061 3.142338  4.00
# 5 0.9 5 11 17 23  7.65 4.418912 3.829724  4.95
# 6 1.0 6 12 18 24  9.00 5.237229 4.582576  6.00

注意：可以通过使用自定义函数并仅在搜索列名时执行一次来对上述方法进行轻微优化，该函数应作为.funs参数提供。
在使用mutate_at函数时，rowwise可能无法作为函数正常工作，可以通过排除列的方式访问数据框中的行号。 - MKR
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接