5

我想加入两个数据框：

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

但是虽然数据看起来不错，但模糊左连接不接受它。

我寻找在更一般情况下工作的解决方案（LHS 上的 n 个变量，RHS 上的 m 个变量，不一定是任意条件的数字）。

更新

我也希望能够在(x=start+1)|(x=end+1)这里表达条件，比如给：

#   x  y
#1  1  a
#2  3  a
#3  5  b
4

5 回答 5

5

对于这种情况，您不需要multi_byor 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
于 2019-03-02T09:11:03.480 回答
2

我最终找到了fuzzy_join 的代码，并找到了一种方法来制作我想要的东西，即使没有适当的文档。blur_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)
于 2018-05-30T08:01:19.150 回答
1

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
于 2018-05-29T13:27:26.347 回答
1

一个可能的答案来解释我正在尝试做的事情：以某种方式扩展 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
于 2018-06-01T09:10:55.443 回答
0

你可以试试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
于 2018-05-29T11:48:34.867 回答