使用聚合按两个条件合并数据框的列

Question

我有一个这样的矩阵

  P   A   B  C 
  1   2   0  5
  2   1   1  3
  3   0   4  7
  1   1   1  0
  3   1   1  0
  3   0   2  1
  2   3   3  4

我想按 P 和每一列合并/排序行。这样每个 P 值对每一列都有一次，并且对每一列中每个 P 的值求和。结果应该是：

 P  A  B  C
 1  3  0  0 
 1  0  1  0 
 1  0  0  5
 2  4  0  0
 2  0  4  0
 2  0  0  7
 3  1  0  0
 3  0  7  0
 3  0  0  8

我已经尝试过aggregate，但它只能帮助我总结所有列的每个 P 值，以便每个 P 只有一行。

Answer 1

一个想法是在 P 上拆分您的数据框并应用自定义函数 (fun1)，该函数创建一个 0 矩阵并将对角线替换为列的总和。即

fun1 <- function(x){
m1 <- matrix(0, ncol = ncol(x) - 1, nrow = ncol(x) - 1)
diag(m1) <- sapply(x[-1], sum)
return(m1)
       }

l1 <- split(df, df$P)
do.call(rbind, lapply(l1, fun1))

#       [,1] [,2] [,3]
# [1,]    3    0    0
# [2,]    0    1    0
# [3,]    0    0    5
# [4,]    4    0    0
# [5,]    0    4    0
# [6,]    0    0    7
# [7,]    1    0    0
# [8,]    0    7    0
# [9,]    0    0    8

或者把它变成你想要的输出，然后

final_df <- as.data.frame(cbind(rep(names(l1), each = ncol(df)-1), 
                                             do.call(rbind, lapply(l1, fun1))))
names(final_df) <- names(df)

final_df
#  P A B C
#1 1 3 0 0
#2 1 0 1 0
#3 1 0 0 5
#4 2 4 0 0
#5 2 0 4 0
#6 2 0 0 7
#7 3 1 0 0
#8 3 0 7 0
#9 3 0 0 8

Answer 2

另一个想法是使用diag函数本身来创建一个矩阵。然后你可以将这些矩阵 rbind 在一起。

xx=aggregate(. ~ P, df, sum)
yy=xx[,-1]
yy=as.data.frame(t(yy))
cbind(rep(1:ncol(yy),nrow(yy)),do.call("rbind", lapply(yy, function(xx) diag(xx, nrow = nrow(yy), ncol = nrow(yy)))))

      [,1] [,2] [,3] [,4]
 [1,]    1    3    0    0
 [2,]    2    0    1    0
 [3,]    3    0    0    5
 [4,]    1    4    0    0
 [5,]    2    0    4    0
 [6,]    3    0    0    7
 [7,]    1    1    0    0
 [8,]    2    0    7    0
 [9,]    3    0    0    8

Answer 3

我们从'P'列（'i1'）得到频率计数的最大值，aggregate按'P'分组的列得到sum（'df2'），复制'df2的行'由'i1'，split数据集由'P'并将其他列中的非对角元素更改为0并将其返回为data.frame，order并将行名称更改为NULL。

i1 <- max(table(df1$P))
df2 <- aggregate(.~P, df1, sum)
df3 <-  df2[rep(1:nrow(df2), i1)]
res <- unsplit(lapply(split(df3, df3$P), function(x) {
         x[-1] <- diag(3)*x[-1]
         x}), df3$P)
res1 <- res[order(res$P),]
row.names(res1) <- NULL
res1
#  P A B C
#1 1 3 0 0
#2 1 0 1 0
#3 1 0 0 5
#4 2 4 0 0
#5 2 0 4 0
#6 2 0 0 7
#7 3 1 0 0
#8 3 0 7 0
#9 3 0 0 8

---

或者使用data.table，将'data.frame'转换为'data.table'（setDT(df1)），循环遍历Data.table的子集（.SD），得到sum，分组为'P'，复制汇总数据集的行并将非对角元素更改为 0（如第一个解决方案中所述）。

library(data.table)
setDT(df1)[, lapply(.SD, sum), by = P
           ][rep(1:.N, i1)
            ][, .SD*diag(ncol(df1)-1), by = P]
#   P A B C
#1: 1 3 0 0
#2: 1 0 1 0
#3: 1 0 0 5
#4: 2 4 0 0
#5: 2 0 4 0
#6: 2 0 0 7
#7: 3 1 0 0
#8: 3 0 7 0
#9: 3 0 0 8

---

或使用dplyr

library(dplyr)
library(purrr)
d1 <- as.data.frame(diag(i1))
df2 <-  df1 %>% 
             group_by(P) %>% 
             summarise_each(funs(sum)) %>% 
             replicate(i1, ., simplify = FALSE) %>%
             bind_rows() %>% 
             arrange(P)
df2[-1] <- map2(df2[-1], d1, ~.x * .y)
df2
# A tibble: 9 × 4
#      P     A     B     C
#   <int> <dbl> <dbl> <dbl>
#1     1     3     0     0
#2     1     0     1     0
#3     1     0     0     5
#4     2     4     0     0
#5     2     0     4     0
#6     2     0     0     7
#7     3     1     0     0
#8     3     0     7     0
#9     3     0     0     8

Answer 4

除非我遗漏了什么，否则以下内容看起来也有效。 首先计算每个“P”的总和：

s = as.matrix(rowsum(dat[-1], dat$P))

创建最终矩阵：

k = s[rep(1:nrow(s), each = ncol(s)), ]

计算要替换为“0”的索引：

k[col(k) != (row(k) - 1) %% ncol(k) + 1] = 0
k
#  A B C
#1 3 0 0
#1 0 1 0
#1 0 0 5
#2 4 0 0
#2 0 4 0
#2 0 0 7
#3 1 0 0
#3 0 7 0
#3 0 0 8

数据：

dat = structure(list(P = c(1L, 2L, 3L, 1L, 3L, 3L, 2L), A = c(2L, 1L, 
0L, 1L, 1L, 0L, 3L), B = c(0L, 1L, 4L, 1L, 1L, 2L, 3L), C = c(5L, 
3L, 7L, 0L, 0L, 1L, 4L)), .Names = c("P", "A", "B", "C"), class = "data.frame", row.names = c(NA, 
-7L))

计算了s，user20650 的更直接的选择：

matrix(diag(ncol(s)), nrow(s) * ncol(s), ncol(s), byrow = TRUE) * c(t(s))

或者，也可以在相同的想法上使用其他有趣的替代方案：

kronecker(rep_len(1, nrow(s)), diag(ncol(s))) * c(t(s))

diag(ncol(s))[rep(1:ncol(s), nrow(s)), ] * s[rep(1:nrow(s), each = ncol(s)), ]