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

Question

我正在尝试编写一个 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 中的管道分配%<>%，但是我不知道如何避免。

---

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

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

Answer 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)
) 

Answer 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)