Question

我的数据集看起来像以下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列中的每个条目执行相同的操作，以便我需要向{添加另一列{1}}对于这些列中的每一列，我将其余三列的每一行中的条目求和，将此总和除以行条目的标准偏差，并将该比率乘以列{{1}中的相应行值。 }}。例如，获取列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包，但我不是很熟悉。谢谢。

Answer 1

我不确定你是否可以避免双循环结构，尤其是当你必须为每个元素执行此操作时，无论如何我们都可以这样做。

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，然后将其与第一行相乘该行中的元素。我们将这个新矩阵作为原始数据框中的新列附加。

Answer 2

看哪！一些复杂的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

Answer 3

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

Answer 4

一个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

Answer 5

使用mutate_at的解决方案可以通过访问.funs中的当前列名称然后将其排除来实现。基本技巧是在group_by上row_number，以便每行计算i.e. rowSums and 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参数进行一点优化，该参数具有搜索列名称的自定义函数，只执行一次。

加速R中矩阵列的运算

5 个答案: