r - 涉及行特定和整组元素的组特定计算

Question

我在将这个问题的逻辑与 dplyr 的逻辑匹配时遇到了一些麻烦。通常，如果您想将一个组减少到每组一个数字，您可以使用 summarise ，而如果您想为每一行计算一个单独的数字，您可以使用 mutate 。但是如果你想对每行的组进行计算呢？

在下面的示例中， mloc 包含一个指向 pnum 的指针，目标是添加一个新列 nm_child ，该列对于每一行，计算组中指向(即具有相同值)该行的 mloc 值的数量pnum 中的组内索引。使用嵌套循环或 map 很容易做到这一点，如果我知道如何为每个组迭代 1)，& 2) 通过每个元素，& 3) 将 map 输出作为组中的列返回。

library(tidyverse)

ser    <- c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)
pnum   <- c(1:5, 1:6)
mloc   <- c(0, 2, 2, 0, 3, 1, 1, 0, 0, 3, 4)

tb1 <- tibble(ser,pnum,  mloc)
tb2 <- tb1 %>%
group_by(ser) %>%
mutate(nm_child = sum(pnum == mloc))

上面的 nm_child 总是 = 1。我明白为什么它不起作用，但我不明白它为什么这样做。

我也试过

mutate(nm_child = count(pnum == mloc))

(返回

no applicable method for 'groups' applied to an object of class "logical")

以及其他各种事情。我确实通过为中间值添加几列并使用一堆嵌套的 ifelse() 来完成一件事，但是在我的 900 万行上运行需要 20 多分钟——相比之下，例如回归，以及最简单的 dplyr 操作，它们在几秒钟和太快而无法注意到之间变化。

期望的输出:

tb2$nm_child = c(0, 2, 1, 0, 0, 2, 0, 1, 1, 0, 0)

Answer 1

您可以使用 outer 和 rowSums

tb1 %>% 
  group_by(ser) %>% 
  mutate(nm_child = rowSums(outer(pnum, mloc, `==`)))

# # A tibble: 11 x 4
# # Groups:   ser [2]
#      ser  pnum  mloc nm_child
#    <dbl> <int> <dbl>    <dbl>
#  1     1     1     0        0
#  2     1     2     2        2
#  3     1     3     2        1
#  4     1     4     0        0
#  5     1     5     3        0
#  6     2     1     1        2
#  7     2     2     1        0
#  8     2     3     0        1
#  9     2     4     0        1
# 10     2     5     3        0
# 11     2     6     4        0

使用 thelatemail 的示例数据进行基准测试

tb1 <- tb1[rep(1:11,5e4),]
tb1$ser <- rep(1:1e5, rep(5:6,5e4))

tb2 <- as.data.table(tb1)

library(microbenchmark)

microbenchmark(
  sapply = {
    tb1 %>% 
      group_by(ser) %>% 
      mutate(
        nm_child = sapply(pnum, function(x) sum(x == mloc))
      )
  },
  join = {
    tb1 %>%
      group_by(ser, mloc) %>%
      summarise(nm_child=n()) %>%
      left_join(tb1, ., by=c("ser"="ser","pnum"="mloc"))
  },
  outer1 = {
    tb1 %>% 
      group_by(ser) %>% 
      mutate(nm_child = rowSums(outer(pnum, mloc, `==`)))
  },
  outer2 = {
    tb1 %>% 
      group_by(ser) %>% 
      mutate(nm_child = colSums(outer(mloc, pnum, `==`)))
  },
  data.table = {
    tb2[tb2[, .N, by=.(ser,mloc)], on=c("ser","pnum"="mloc"), nm_child := N][]
    },
  times = 10)

基准输出

# Unit: milliseconds
#        expr       min        lq      mean    median        uq        max neval
#      sapply 8233.5740 8297.7331 8939.9369 8647.5935 8956.3364 10706.3362    10
#        join  889.6682  899.0483  935.7493  908.1441  932.2827  1135.8424    10
#      outer1 4551.0428 4631.1605 5184.9359 4986.7327 5160.0109  7563.4190    10
#      outer2 4495.9134 4552.1169 4763.5954 4723.7783 4893.2190  5198.4556    10
#  data.table  108.7449  115.7866  124.4453  120.6742  125.7591   171.8111    10