对具有相交组的小标题执行类似“top_n”的操作

Posted 2023-03-16

【中文标题】对具有相交组的小标题执行类似“top_n”的操作

【英文标题】：Performing `top_n`-like operations on tibbles with intersecting groups

【发布时间】：2020-10-21 23:12:43

【问题描述】：

我正在尝试编写一个 R 脚本来执行以下任务。我有两个小标题：

library(dplyr); library(magrittr)

(
tibs <- list(
        top = tibble(
                letter = c(rep("A",4),rep("B",4)), 
                number = c(rep(1,2), rep(2,2)) %>% rep(2),
                element = c("x","y","z","w","x","y","z","w"),
                score = 1:8
                ) %>% group_by(letter,number),
        bottom = tibble(
                letter = c(rep("A",2),rep("B",2)),
                element = c("p","q","y","z"),
                score = c(2.5,3.5, 4,5.5)
                ) %>% group_by(letter)
        )
)

# A tibble: 8 x 4
# Groups:   letter, number [4]
  letter number element score
  <chr>   <dbl> <chr>   <int>
1 A           1 x           1
2 A           1 y           2
3 A           2 z           3
4 A           2 w           4
5 B           1 x           5
6 B           1 y           6
7 B           2 z           7
8 B           2 w           8

$bottom
# A tibble: 4 x 3
# Groups:   letter [2]
  letter element score
  <chr>  <chr>   <dbl>
1 A      p         2.5
2 A      q         3.5
3 B      y         4  
4 B      z         5.5

对于***标题的每个组Xn，由字母（X = "A" 或 "B"）和数字（n = 1 或 2）定义，我想选择两个得分最低的元素，出现在***标题的Xn 组或较低级别标题的X 组中。如果一个元素同时出现在顶层和底层 tibble 中，则它的分数取自 top tibble。

因此，在此示例中，我希望为A1 组获得x,y，A2 组为p,z，B1 组为x,z，B2 组为y,z .

我必须对具有多达一百万个不同组（在***）以及每个组中的几个条目的（***）小标题执行这种操作。我想获得一个快速并且可能可读的解决方案，无论是否在 dplyr 内。

---

到目前为止，我的解决方案返回了预期的输出，但从效率的角度来看特别不令人满意：

summarizer <- function(letter, element, score, bottom)
        bottom %<>% filter(letter == !!letter[1], !(element %in% !!element))
        order(c(score, bottom$score)) %>%
                c(element, bottom$element)[.] %>%
                head(2) %>%
                paste0(collapse = " ")



tibs$top %>% summarise(preds = summarizer(letter, element, score, 
                                          tibs$bottom)
                       )


# A tibble: 4 x 3
# Groups:   letter [2]
  letter number preds
  <chr>   <dbl> <chr>
1 A           1 x y  
2 A           2 p z  
3 B           1 x z  
4 B           2 y z  

特别是，对于大量组，最大的瓶颈是我的函数summarizer 中的管道分配%<>%，但是我不知道如何避免。

---

我有以下与上述相关的问题：

dplyr 的 group_by 组在构造上是从不相交的。有没有办法（在 dplyr 内）对 data.frames 进行分组，使行可以属于多个组？ 如果没有，我的任务可以通过创建属于更多组的元素的副本并适当地标记它们来解决。您将如何快速做到这一点？ 您是否看到任何其他快速（并且可能是可读的）解决方案来解决上述问题？

【问题讨论】：

您说您想“选择两个得分最高的元素”，因此您（1）将较低的得分值视为“更好”或“更高”，或者您的（2）summarizer选择了错误的元素，因为在A 1 组中，例如p 和q 的分数高于x 和y。

@TimTeaFan，这是选项 1，谢谢。已编辑

您会考虑使用 data.table 解决方案吗？

@chinsoon12 实际上想知道这是否有帮助。我对data.table没有经验，如果您有任何想法并想分享，我将非常感激。

【参考方案1】：

这是一个使用data.table的选项。

library(data.table)
setDT(top)
setDT(bottom)

#get unique groups
g = unique(top[,.(letter, number)])

#creating duplicates for each letter in bottom for each group using a left join on letter
b = bottom[g, on=.(letter)]

#If an element appears both in the top- and lower-level tibble, it's score is taken from the top tibble.
#use an update join to lookup the scores from top tibble
b[top, on=.(letter, number, element), score := i.score]

#bind_rows and remove identical rows
rowsbind = rbindlist(list(top, b), use.names=TRUE)
both = unique(rowsbind, by=c("letter", "number", "element"))

#order and subset
setorder(both, letter, number, score)
both[rowid(letter, number) <= 2L]

数据：

library(data.table)
top = data.table(
    letter = c(rep("A",4),rep("B",4)), 
    number = rep(c(rep(1,2), rep(2,2)), 2),
    element = c("x","y","z","w","x","y","z","w"),
    score = as.double(1:8)
)
bottom = data.table(
    letter = c(rep("A",2),rep("B",2)),
    element = c("p","q","y","z"),
    score = c(2.5,3.5, 4,5.5)
) 

【讨论】：

非常感谢，使用左连接是我需要的提示。我将在 dplyr 中添加实现作为单独的答案。

【参考方案2】：

与已接受答案中的策略相同，但使用 dplyr。

top1 <- bind_rows(bottom %>% left_join(top %>% select(letter, number) %>% unique),
                  top,
                  .id = "id") %>%
        group_by(letter, number, element) %>% top_n(1, wt = id) %>% ungroup %>% 
        group_by(letter, number) %>%
        mutate(rank = rank(score, ties.method = "first")) %>%
        filter(rank <= 2) %>%
        select(letter, number, element, score)

【讨论】：

在性能方面，我会对这三种方法在应用于您的真实数据时有何不同感兴趣。我使用nest_by 和bind_rows/filter 在 dplyr 中重写了您的第一种方法，它在性能方面比您原来的方法差得多。它慢了 8 倍（但可读性很好；）。我的猜测是，您的第一种方法非常高效，因为您主要使用向量运算（而不是data.frames）。我希望dplyr 的解决方案会更慢，而data.table 的解决方案会最快。

亲爱的@TimTeaFan，我还没有在我的实际数据上实现@chinsoon12 提出的data.table 解决方案，因为我之前的所有代码都是使用dplyr 编写的。我希望在接下来的几天里有时间对它进行一些试验，因为正如你所说，它的性能可能会比dplyr 更好。关于dplyr 中的两种方法：考虑到我的top tibble 有~900k 组（Xn 类）和我的bottom tibble 有~30k 组（X 类），两者都有四个每个组中的条目。使用我以前的实现，执行上述操作大约需要 70 分钟，[...]

[...] 和这个答案中提出的那个大约 4 分钟。巨大的改进似乎来自于避免在我的摘要函数中进行过滤，例如：bottom %<>% filter(letter == !!letter[1], !(element %in% !!element))。这会导致巨大的内存分配 - 释放（我无法在此数据集上运行 profvis ......在减少的数据集上我有大约 0.5 TB 的已分配/释放内存）。如果我在接下来的几天里找到一些时间，我会上传我的数据和一些基准。感谢您的关注！