Как сделать нечеткое соединение в R, используя более одной переменной на каждой стороне

Question

Я хотел бы объединить два фрейма данных:

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', но не могу найти примеры, которые бы соответствовали моим потребностям: функция для применения условия имеет только два аргумента.Я также попытался поместить 'start' и 'end' в один аргумент с 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 не принимает их.

Я ищу работающие решенияв более общих случаях (n переменных на LHS, m на RHS, необязательно числовые с произвольными условиями).

ОБНОВЛЕНИЕ

Я также хочу иметь возможностьвыразить условия, такие как (x=start+1)|(x=end+1) здесь:

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

Answer 1

Для этого случая вам не нужны 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

Answer 2

Возможный ответ, чтобы объяснить, что я пытаюсь сделать: каким-то образом расширить 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

Answer 3

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

Answer 4

В конце концов я пошел к коду 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)

Answer 5

Вы можете попробовать 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