对具有交叉组的 tibbles 执行类似于“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

对于 top-level tibble 的每个组 Xn，由字母（X =“A”或“B”）和数字（n = 1或 2)，我想要 select 两个得分最低的元素，它们出现在 top-level tibble 的组 Xn 或较低级别的组 X 中小声。如果一个元素同时出现在顶部和 lower-level 小标题中，则它的分数取自 top 小标题。

所以，在这个例子中，我希望A1组得到x,y，A2组得到p,z，x,z组得到x,z B1 和 y,z 组 B2。

我必须对 (top-level) 个具有多达一百万个不同组（在顶层）并且每个组中有几个条目的 tibbles 执行这种操作。我想获得一个 fast 并且可能 readable 解决方案，无论是否在 dplyr 内。

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

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 中的 pipe-assignment %<>%，但是我看不出如何避免。

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

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

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)

对具有交叉组的 tibbles 执行类似于“top_n”的操作

Performing `top_n`-like operations on tibbles with intersecting groups

grouping

r

greatest-n-per-group

dplyr

tibble