按组和条件进行左连接（`tidyverse`或`data.table`）

Question

我有一个非常大的数据框，其中包含整数列state和state_cyclen。每一行都是一个游戏帧，而state描述了该帧中游戏所处的状态，state_cyclen编码表示该状态发生的次数（基本上是data.table :: rleid（state））。在以state为条件并按state_cyclen进行循环的情况下，我需要从其他定义数据框导入几列。定义数据框存储关于状态的属性，它们的行顺序说明这些属性在整个游戏中如何循环（玩家多次遇到每个游戏状态）。

以下是应该进行左连接的长数据的最小示例：

data <- data.frame(
  state        = c(1, 1, 2, 2, 3, 3, 1, 1, 2, 2, 3, 3, 2, 2, 3, 3, 3, 4, 4, 3, 3),
  state_cyclen = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 1, 1, 4, 4)
)

data 
#>    state state_cyclen
#> 1      1            1
#> 2      1            1
#> 3      2            1
#> 4      2            1
#> 5      3            1
#> 6      3            1
#> 7      1            2
#> 8      1            2
#> 9      2            2
#> 10     2            2
#> 11     3            2
#> 12     3            2
#> 13     2            3
#> 14     2            3
#> 15     3            3
#> 16     3            3
#> 17     3            3
#> 18     4            1
#> 19     4            1
#> 20     3            4
#> 21     3            4

定义存储排序的数据框的最小示例：

def_one <- data.frame(
  prop = letters[1:3],
  others = LETTERS[1:3]
)  

def_two <- data.frame(
  prop = letters[4:10],
  others = LETTERS[4:10]
) 

def_three <- data.frame(
  prop = letters[11:12],
  others = LETTERS[11:12]
) 

我有一个基于R语言的解决方案可以得到所需的输出，但它既不易读，也可能不是很高效。

# Add empty columns
data$prop <- NA
data$others <- NA

# Function that recycles numeric vector bounded by a upper limit 
bounded_vec_recyc <- function(vec, n) if(n == 1) vec else (vec - 1) %% n + 1

# My solution
vec_pos_one <- data[data[, "state"] == 1, ]$state_cyclen 
vec_pos_one <- bounded_vec_recyc(vec_pos_one, n = nrow(def_one))
data[data[, "state"] == 1, ][, c("prop", "others")] <- def_one[vec_pos_one,]
  

vec_pos_two <- data[data[, "state"] == 2, ]$state_cyclen 
vec_pos_two <- bounded_vec_recyc(vec_pos_two, n = nrow(def_two))
data[data[, "state"] == 2, ][, c("prop", "others")] <- def_two[vec_pos_two,]


vec_pos_three <- data[data[, "state"] == 3, ]$state_cyclen 
vec_pos_three <- bounded_vec_recyc(vec_pos_three, n = nrow(def_three))
data[data[, "state"] == 3, ][, c("prop", "others")] <- def_three[vec_pos_three,]

data
#>    state state_cyclen prop others
#> 1      1            1    a      A
#> 2      1            1    a      A
#> 3      2            1    d      D
#> 4      2            1    d      D
#> 5      3            1    k      K
#> 6      3            1    k      K
#> 7      1            2    b      B
#> 8      1            2    b      B
#> 9      2            2    e      E
#> 10     2            2    e      E
#> 11     3            2    l      L
#> 12     3            2    l      L
#> 13     2            3    f      F
#> 14     2            3    f      F
#> 15     3            3    k      K
#> 16     3            3    k      K
#> 17     3            3    k      K
#> 18     4            1 <NA>   <NA>
#> 19     4            1 <NA>   <NA>
#> 20     3            4    l      L
#> 21     3            4    l      L

^{本文于2022-08-30使用reprex v2.0.2创建}

TLDR：如您所见，我基本上是在按照对应的state逐个合并这些定义数据框到主数据框中，通过循环利用定义数据框的行并保留它们的顺序，使用state_cyclen列来跟踪每种状态在整个游戏过程中的出现次数。

是否有一种更快或至少更易读的方法在tidyverse或data.table中完成此操作？我需要这个方法运行得相当快，因为我有许多这样的游戏框架文件（数百个），而且它们很长（数十万行）。

P.S.不确定标题是否足够描述我正在进行的操作，因为我可以想象多种实现方式。欢迎编辑。

- Claudiu Papasteri

---

当 def_three 只有两行时，为什么第13行能找到 state:3 和 state_cyclen:3 的匹配项呢？ - Jon Spring

@Jon Spring 这就是诀窍。例如，状态X的定义数据帧可能包含3行，在该状态的长数据帧中可能会遇到100次。这些100次应通过循环3：1-2-3-1-2-3…合并到它上面，直到第100个。 - Claudiu Papasteri

@akrun 是的，它们是。 - Claudiu Papasteri

对于您以前的 plotly 2 legend 1，抱歉使用了 wayback machine，但您是否对[plotly 2, legend 1有任何看法？抱歉分心了。 - Chris

Answer 1

在这里，我制作了一个查找表，将三个来源合并。然后我将数据与每个州的行数进行连接，使用该数字对data中的state_cyclen进行模运算，使其在查找范围内，然后进行连接。

library(tidyverse)
def <- bind_rows(def_one, def_two, def_three, .id = "state") %>%
  mutate(state = as.numeric(state))  %>%
  group_by(state) %>%
  mutate(state_cyclen_adj = row_number()) %>%
  ungroup()

data %>%
  left_join(def %>% count(state)) %>%
  # eg for row 15 we change 3 to 1 since the lookup table only has 2 rows
  mutate(state_cyclen_adj = (state_cyclen - 1) %% n + 1) %>%
  left_join(def)


Joining, by = "state"
Joining, by = c("state", "state_cyclen_adj")
   state state_cyclen  n state_cyclen_adj prop others
1      1            1  3                1    a      A
2      1            1  3                1    a      A
3      2            1  7                1    d      D
4      2            1  7                1    d      D
5      3            1  2                1    k      K
6      3            1  2                1    k      K
7      1            2  3                2    b      B
8      1            2  3                2    b      B
9      2            2  7                2    e      E
10     2            2  7                2    e      E
11     3            2  2                2    l      L
12     3            2  2                2    l      L
13     2            3  7                3    f      F
14     2            3  7                3    f      F
15     3            3  2                1    k      K
16     3            3  2                1    k      K
17     3            3  2                1    k      K
18     4            1 NA               NA <NA>   <NA>
19     4            1 NA               NA <NA>   <NA>
20     3            4  2                2    l      L
21     3            4  2                2    l      L

- Jon Spring

Answer 2

这里有一个 data.table 的解决方案。不确定它是否更易读，但很确定它更高效：

library(data.table)

dt <- rbind(setDT(def_one)[,state := 1],
            setDT(def_two)[,state := 2],
            setDT(def_three)[,state := 3])
dt[,state_cyclen := 1:.N,by = state]

data <- setDT(data)
data[dt[,.N,by = state],
     state_cyclen := bounded_vec_recyc(state_cyclen,i.N),
     on = "state",
     by = .EACHI]

dt[data,on = c("state","state_cyclen")]

    prop others state state_cyclen
 1:    a      A     1            1
 2:    a      A     1            1
 3:    d      D     2            1
 4:    d      D     2            1
 5:    k      K     3            1
 6:    k      K     3            1
 7:    b      B     1            2
 8:    b      B     1            2
 9:    e      E     2            2
10:    e      E     2            2
11:    l      L     3            2
12:    l      L     3            2
13:    f      F     2            3
14:    f      F     2            3
15:    k      K     3            1
16:    k      K     3            1
17:    k      K     3            1
18: <NA>   <NA>     4            1
19: <NA>   <NA>     4            1
20:    l      L     3            2
21:    l      L     3            2
    prop others state state_cyclen

按步骤进行： 我将def_one、def_two和def_three数据框绑定在一起，创建了一个包含你需要合并的变量的data.table。

dt <- rbind(setDT(def_one)[,state := 1],
            setDT(def_two)[,state := 2],
            setDT(def_three)[,state := 3])
dt[,state_cyclen := 1:.N,by = state]

如果您想合并许多数据框，可以使用rbindlist和一个数据表列表。

然后我修改了您数据中的state_cyclen以执行与您相同的循环处理。

dt[,.N,by = state]

   state N
1:     1 3
2:     2 7
3:     3 2

提供用于定义回收的长度。

data[dt[,.N,by = state],
     state_cyclen := bounded_vec_recyc(state_cyclen,i.N),
     on = "state",
     by = .EACHI]

我使用by = .EACHI来修改每个组的变量，使用dt[,.N,by = state]中的N变量进行合并。

然后我只需要进行左连接：

dt[data,on = c("state","state_cyclen")]

- denis

Answer 3

nest/unnest选项

library(dplyr)
library(tidyr)
data %>% 
  nest_by(state) %>%
  left_join(tibble(state = 1:3, dat = list(def_one, def_two, def_three))) %>% 
  mutate(data = list(bind_cols(data, if(!is.null(dat))
    dat[data %>%
    pull(state_cyclen) %>%
    bounded_vec_recyc(., nrow(dat)),] else NULL)), dat = NULL) %>% 
  ungroup %>% 
  unnest(data)

-输出

# A tibble: 21 × 4
   state state_cyclen prop  others
   <dbl>        <dbl> <chr> <chr> 
 1     1            1 a     A     
 2     1            1 a     A     
 3     1            2 b     B     
 4     1            2 b     B     
 5     2            1 d     D     
 6     2            1 d     D     
 7     2            2 e     E     
 8     2            2 e     E     
 9     2            3 f     F     
10     2            3 f     F     
# … with 11 more rows

- akrun