用 sum+product 在 R 中重铸

Question

我有一个如下所示的数据框：

x   y   value   weight
10  1   red 1
3.4 5   blue    2
10  10  blue    0.5
3   8   blue    0.5
3   8   red 4
10  1   blue    1
3   8   blue    2
3   8   blue    0.25

我想重铸它，使每一行都是“x”和“y”的唯一组合，而列是“值”的每个不同值的“权重”之和。如果可能的话，我也希望有列用于“值”值的原始计数。所以对于这些数据来说：

x   y   red_count   blue_count  red_sum_of_weights  blue_sum_of_weights
10  1   1   1   1   1
3.4 5   0   1   0   2
10  10  0   0   1   0.5
3   8   1   3   4   2.75

有没有办法通过 reshape 或 reshape2 来做到这一点？我可以用它来计算值

dcast(data,x+y~value)

但我无法弄清楚如何让它以我想要的方式使用权重。我需要它来处理任意数量的可能值级别和原始数据集中每个 x*y 组合的任意不同行数。我已经编写了自己的代码，只是使用 for 循环来执行此操作，但是运行需要 非常 很长时间 - 到目前为止，完成 600k 行数据集的前 15% 需要 6 个小时，这不是很实用！但是我确定必须有一种方法可以使用现有功能来做到这一点？

非常感谢您的任何帮助！

Answer 1

您可以结合使用dplyr 和reshape2 函数来完成此操作。首先，按x、y 和value 分组（我们将后者的名称更改为color，只是为了避免熔化后的列名重复），然后计算每个子组的计数和总和。然后melt结果将新计算的摘要放入“长”格式。最后，dcast 得到您要求的“宽”格式。

library(reshape2)
library(dplyr)

df %>% group_by(x,y,color=value) %>% 
  summarise(count=n(), sum=sum(weight)) %>%
  melt(id.var=c("x","y","color")) %>%
  dcast(x + y ~ variable + color)

     x  y count_blue count_red sum_blue sum_red
1  3.0  8          3         1     2.75       4
2  3.4  5          1        NA     2.00      NA
3 10.0  1          1         1     1.00       1
4 10.0 10          1        NA     0.50      NA

Answer 2

数据表的另一种方法：

require(data.table)

count=dcast(df,x+y~paste(value,"_count",sep=""))
weights=dcast(df,x+y~paste(value,"_sum_of_weights",sep=""),value.var = "weight",fun.aggregate = sum)
result=merge(count,weights,by=c("x","y"))

结果：

    x  y blue_count red_count blue_sum_of_weights red_sum_of_weights
 10.0  1          1         1                1.00                  1
 10.0 10          1         0                0.50                  0
  3.0  8          3         1                2.75                  4
  3.4  5          1         0                2.00                  0

虽然我不得不承认，如果我们可以在 dcast 中使用两个函数，它会简单得多。据说可以，但是一直报错... 经过一番挖掘，我在这个线程reshape2: multiple results of aggregation function? 中找到了一个非常好的答案，它为 dcast 定义了一个包装函数，如下所示：

dcastMult <- function(data, formula, value.var = "value", 
                   funs = list("min" = min, "max" = max)) {
  require(reshape2)
  if (is.null(names(funs)) | any(names(funs) == "")) stop("funs must be named")
  Form <- formula(formula)
  LHS <- as.character(Form[[2]])
  if (length(LHS) > 1) LHS <- LHS[-1]
  temp <- lapply(seq_along(funs), function(Z) {
    T1 <- dcast(data, Form, value.var = value.var, 
                fun.aggregate=match.fun(funs[[Z]]), fill = 0)
    Names <- !names(T1) %in% LHS
    names(T1)[Names] <- paste(names(T1)[Names], names(funs)[[Z]], sep = "_")
    T1
  })
  Reduce(function(x, y) merge(x, y), temp)
}

使用这个可爱的函数，我们得到如下结果：

result=dcastMult(df,x+y~value,funs = list("count"=length,"sum_of_weights"=sum),value.var = "weight")

Answer 3

另一种选择：

df %>% 
  group_by(x, y, value) %>% 
  summarise(count = n(), sum = sum(weight)) %>%
  gather(key, val, -(x:value)) %>%
  unite(newkey, value, key) %>%
  spread(newkey, val)

这给出了：

#Source: local data frame [4 x 6]
#Groups: x, y [4]
#
#      x     y blue_count blue_sum red_count red_sum
#* <dbl> <int>      <dbl>    <dbl>     <dbl>   <dbl>
#1   3.0     8          3     2.75         1       4
#2   3.4     5          1     2.00        NA      NA
#3  10.0     1          1     1.00         1       1
#4  10.0    10          1     0.50        NA      NA

Answer 4

这是使用data.table::dcast 的简单解决方案：

require(data.table)
dcast(dt, x + y ~ value, value.var = "weight", fun.aggregate = list(length, sum))
#       x  y weight_length_blue weight_length_red weight_sum_blue weight_sum_red
# 1:  3.0  8                  3                 1            2.75              4
# 2:  3.4  5                  1                 0            2.00              0
# 3: 10.0  1                  1                 1            1.00              1
# 4: 10.0 10                  1                 0            0.50              0

在哪里，

dt = fread('x   y   value   weight
           10  1   red 1
           3.4 5   blue    2
           10  10  blue    0.5
           3   8   blue    0.5
           3   8   red 4
           10  1   blue    1
           3   8   blue    2
           3   8   blue    0.25
           ')