我想连接两个数据框：
a <- data.frame(x=c(1,3,5))
b <- data.frame(start=c(0,4),end=c(2,6),y=c("a","b"))
使用像(x>start)&(x<end)这样的条件才能获得这样的结果：
# x y
#1 1 a
#2 2 <NA>
#3 3 b
我不想制作一个潜在的大笛卡尔产品，然后只选择符合条件的几行，我想要一个使用 tidyverse 的解决方案(我对使用 SQL 的解决方案不感兴趣，这将是失败的承认(。 我想到了"fuzzyjoin"包，但我找不到适合我需求的示例：申请条件的函数只有两个参数。我还试图将"开始"和"结束"放入一个带有data.frame(z=I(purrr::map2(b$start,b$end,list)),y=b$y)
# z y
#1 0, 2 a
#2 4, 6 b的论点中
但是，尽管数据看起来不错，fuzzy_left_join不接受它。
我搜索适用于更一般情况的解决方案(LHS 上的 n 个变量，RHS 上的 m，不一定是任意条件的数字(。
更新
我还希望能够在这里表达像(x=start+1)|(x=end+1)给予这样的条件：
# x y
#1 1 a
#2 3 a
#3 5 b
在这种情况下，您不需要multi_by或multy_match_fun，这有效：
library(fuzzyjoin)
fuzzy_left_join(a, b, by = c(x = "start", x = "end"), match_fun = list(`>`, `<`))
# x start end y
# 1 1 0 2 a
# 2 3 NA NA <NA>
# 3 5 4 6 b
我最终去了fuzzy_join的代码，并找到了一种方法来制作我想要的东西，即使没有适当的文档。 fuzzy_let_join不起作用，但有以下方法(不是很漂亮，它实际上是一个笛卡尔产品(：
g <- function(x,y) (x>y[,"start"])&(x<y[,"end"])
fuzzy_join(a,b, multi_by = list(x="x",y=c("start","end"))
, multi_match_fun = g, mode = "left") %>% select(x,y)
data.table方法可能是
library(data.table)
name1 <- setdiff(names(setDT(b)), names(setDT(a)))
#perform left outer join and then select required columns
a[b, (name1) := mget(name1), on = .(x > start, x < end)][, .(x, y)]
这给了
x y
1: 1 a
2: 3 <NA>
3: 5 b
示例数据：
a <- data.frame(x = c(1, 3, 5))
b <- data.frame(start = c(0, 4), end = c(2, 6), y = c("a", "b"))
更新：如果您想(x=start+1)|(x=end+1)条件下加入两个数据帧，那么您可以尝试
library(data.table)
DT1 <- as.data.table(a)
DT2 <- as.data.table(b)
#Perform 1st join on "x = start+1" and then another on "x = end+1". Finally row-bind both results.
DT <- rbindlist(list(DT1[DT2[, start_temp := start+1], on = c(x = "start_temp"), .(x, y), nomatch = 0],
DT1[DT2[, end_temp := end+1], on = c(x = "end_temp"), .(x, y), nomatch = 0]))
DT
# x y
#1: 1 a
#2: 5 b
#3: 3 a
一个可能的答案来解释我正在尝试做什么：以某种方式扩展 dplyr。我很高兴知道是否有办法改进这个解决方案或一些我没有看到的问题。 该解决方案避免了笛卡尔积，而是将输入数据框之一和结果复制到数据框列表中。我没有包括易于编码的 x 和 y 的最终列选择。
my_left_join <- function(.DATA1,.DATA2,.WHERE)
{
call = as.list(match.call())
df1 <- .DATA1
df1$._row_ <- 1:nrow(df1)
dfl1 <- replyr::replyr_split(df1,"._row_")
eval(substitute(
dfl2 <- mapply(function(.x)
{filter(.DATA2,with(.x,WHERE)) %>%
mutate(._row_=.x$._row_)}
, dfl1, SIMPLIFY=FALSE)
,list(WHERE=call$.WHERE)))
df2 <- replyr::replyr_bind_rows(dfl2)
left_join(df1,df2,by="._row_") %>% select(-._row_)
}
my_left_join(a,b,(x>start)&(x<end))
# x start end y
#1 1 0 2 a
#2 3 NA NA <NA>
#3 5 4 6 b
my_left_join(a,b,(x==(start+1))|(x==(end+1)))
# x start end y
#1 1 0 2 a
#2 3 0 2 a
#3 5 4 6 b
您可以尝试GenomicRanges解决方案
library(GenomicRanges)
# setup GRanges objects
a_gr <- GRanges(1, IRanges(a$x,a$x))
b_gr <- GRanges(1, IRanges(b$start, b$end))
# find overlaps between the two data sets
res <- as.data.frame(findOverlaps(a_gr,b_gr))
# create the expected output
a$y <- NA
a$y[res$queryHits] <- as.character(b$y)[res$subjectHits]
a
x y
1 1 a
2 3 <NA>
3 5 b