使用来自另一个数据帧的起点和终点对数据帧进行子集？

Question

我有一个包含 3 列 id 的数据框 df，第一列和最后一列

id <- c(27,27,134,134)
first <- c(14,20,9,16)
last <- c(17,24,13,20)
df <- as.data.frame(cbind(id,first,last))
df

每一行对应于我要保留的另一个数据帧中的一大块数据。 first 和 last 表示相关块的第一帧和最后一帧 我想用它来子集结构如下的其他数据帧数据

dat_id <- c(rep(27, 30), rep(134,30))
dat_frame <- c(seq(1:30), seq(1:30))
dat_data <- c(sample(1:60))

dat <- as.data.frame(cbind(dat_id,dat_frame,dat_data))
dat

我知道提取相关部分的唯一方法是使用如下的 for 循环（这会产生预期的输出），但我认为这是一种非常低效的方法。有什么更好的方法？

#header row
new_df <- data.frame(id = numeric(), frame = numeric(), data = numeric())

#populate
for (i in (seq (1:nrow(df)))){
    new_df <- rbind(new_df, subset(dat, dat_id == df[i,"id"])[df[i,"first"]:df[i,"last"],])
}

new_df

Answer 1

这可以通过 sql 中的复杂连接来完成。这避免了基于仅在 id 上加入然后将其削减来创建大型中间数据帧。

library(sqldf)

sqldf("
  select dat.*
    from dat 
    join df on dat.dat_id = df.id and 
               dat.dat_frame between df.first and df.last
 ")

更新

问题中的示例已更改，并且假设使用新示例，解决方案已被简化。

Answer 2

使用dplyr，我们可以在dat 和df 上执行left_join，并仅选择位于它们各自id 的between first 和last 中的那些行。

library(dplyr)

left_join(dat, df, by = c("dat_id" = "id")) %>%
   filter(between(dat_frame, first, last)) %>%
   select(-first, -last)

或者在base R中使用相同的逻辑

subset(merge(dat, df, by.x = "dat_id", by.y = "id", all.x = TRUE), 
             dat_frame >= first & dat_frame <= last)

Answer 3

我们可以为此使用非 equi 连接。会更快更高效

library(data.table)
setDT(dat)[, newcol := dat_frame][df, on = .(dat_id = id,
    newcol >= first, newcol <=last)][, .(dat_id, dat_frame, dat_data)]
#     dat_id dat_frame dat_data
# 1:     27        14       26
# 2:     27        15       56
# 3:     27        16       30
# 4:     27        17       49
# 5:     27        20       23
# 6:     27        21       37
# 7:     27        22        7
# 8:     27        23       40
# 9:     27        24       12
#10:    134         9       57
#11:    134        10       35
#12:    134        11       31
#13:    134        12       53
#14:    134        13       38
#15:    134        16       15
#16:    134        17       14
#17:    134        18       33
#18:    134        19       54
#19:    134        20       43

---

或者另一个选项是fuzzyjoin

library(fuzzyjoin)
library(dplyr)
dat %>% 
    mutate(newcol = dat_frame) %>%
    fuzzy_left_join(df, by = c("dat_id" = 'id', 'newcol' = 'first', 
      'newcol' = 'last'), match_fun = list(`==`, `>=`, `<=`)) %>% 
    na.omit %>%
    select(dat_id, dat_frame, dat_data)
#   dat_id dat_frame dat_data
#14     27        14       26
#15     27        15       56
#16     27        16       30
#17     27        17       49
#20     27        20       23
#21     27        21       37
#22     27        22        7
#23     27        23       40
#24     27        24       12
#39    134         9       57
#40    134        10       35
#41    134        11       31
#42    134        12       53
#43    134        13       38
#46    134        16       15
#47    134        17       14
#48    134        18       33
#49    134        19       54
#50    134        20       43

---

或者使用base R

out <-  do.call(rbind, Map(function(x, y) do.call(rbind, 
  Map(function(u, v) subset(x,  dat_frame >= u & dat_frame <= v), 
     y$first, y$last)), split(dat, dat$dat_id), split(df, df$id)))
row.names(out) <- NULL
out
#   dat_id dat_frame dat_data
#1      27        14       26
#2      27        15       56
#3      27        16       30
#4      27        17       49
#5      27        20       23
#6      27        21       37
#7      27        22        7
#8      27        23       40
#9      27        24       12
#10    134         9       57
#11    134        10       35
#12    134        11       31
#13    134        12       53
#14    134        13       38
#15    134        16       15
#16    134        17       14
#17    134        18       33
#18    134        19       54
#19    134        20       43

注意：以上所有解决方案都有效

---

另外，请注意，另一篇文章中的解决方案给出了Error

left_join(dat, df, by = c("dat_id" = "id")) %>%
    filter(between(dat_frame, first, last)) %>%
    select(-first, -last)
#Error: Expecting a single value: [extent=120].

注意：接受的答案是错误的并且它给出了错误。