Присоединяйтесь к кадрам данных по нескольким столбцам с помощью grep

Я хочу сделать полное соединение с двумя фреймами данных на основе 2 столбцов, где 1 столбец содержит строку, найденную в другом. Ниже приведены два моих фрейма данных:

date<-as.Date(c('2010-11-1','2008-3-25','2007-3-14'))
site<-c("abcejams.com", "reitimes.com", "posehbc")
desc1<-c("alpha", "beta", "gamma"
df1<-data.frame(date, site, desc1)
df1

        date         site    desc1
1 2010-11-01 abcejams.com    alpha
2 2008-03-25 reitimes.com     beta
3 2007-03-14      posehbc    gamma

date2<-as.Date(c('2010-11-1','2008-3-25','2007-3-14', '2018-2-9'))
site2<-c("jams", "time", "pose", "abce")
metric2<-c(1,2,3,4)
metric3<-c(10,20,30,40)
df2<-data.frame(date2, site2, metric2, metric3)
df2

       date2 site2 metric2 metric3
1 2010-11-01  jams       1      10
2 2008-03-25  time       2      20
3 2007-03-14  pose       3      30
4 2018-02-09  abce       4      40

Я хочу присоединиться к этому по дате и сайту, основываясь на том, что site2 находится на сайте по дате. Вот как вы обычно делаете это без части grep.

finaldf<-full_join(df1, df2, by = c("date"="date2", "site" = "site2"))

Есть способ сделать это с помощью sqldf, но единственным вариантом является левое соединение, а не полное соединение:

test<-sqldf("df1.*, df2.metric2, 
df2.metric3 
        from df1 
        left join df2 
        on 
        instr(df1.site,  df2.site2)
        and 
        df1.date=df2.date2")

Цель состоит в том, чтобы конечный результат выглядел так:

        date         site     desc1     metric2    metric3
1 2010-11-01 abcejams.com     alpha           1         10 
2 2008-03-25 reitimes.com      beta           2         20
3 2007-03-14      posehbc     gamma           3         30
4 2018-02-09         abce        NA           4         40

У кого-нибудь есть опыт в этом?


r join grepl dplyr
person nak5120    schedule 21.02.2018    source источник

Ответы (2)


arrow_upward
3
arrow_downward

Вы можете использовать пакет fuzzyjoin и использовать пакет regex_full_join. Я не верю, что он сейчас находится в CRAN, поэтому проверьте страницу github, чтобы установить его.

library(fuzzyjoin)

date <- as.Date(c('2010-11-1', '2008-3-25', '2007-3-14'))
site <- c("abcejams.com", "reitimes.com", "posehbc")

df1 <- data.frame(date, site, stringsAsFactors = FALSE)

date2 <- as.Date(c('2010-11-1', '2008-3-25', '2007-3-14', '2018-2-9'))
site2 <- c("jams", "time", "pose", "abce")
metric2 <- c(1, 2, 3, 4)
metric3 <- c(10, 20, 30, 40)

df2 <- data.frame(date2, site2, metric2, metric3, stringsAsFactors = FALSE)

regex_full_join(df1, df2, by = c("site" = "site2", "date" = "date2"))


            date         site      date2 site2 metric2 metric3
1 2010-11-01 abcejams.com 2010-11-01  jams       1      10
2 2008-03-25 reitimes.com 2008-03-25  time       2      20
3 2007-03-14      posehbc 2007-03-14  pose       3      30
4       <NA>         <NA> 2018-02-09  abce       4      40
person Jake Kaupp    schedule 21.02.2018
comment
Спасибо, я получил сообщение об ошибке, которое гласит: Error: Can only modify plain character vectors. Разве вы не получили ту же ошибку, которую я предполагаю? - person nak5120; 24.02.2018
comment
Обратите внимание на изменение stringsAsFactors = FALSE при создании фрейма данных. - person Jake Kaupp; 24.02.2018

arrow_upward
0
arrow_downward 

# original data
date<-as.Date(c('2010-11-1','2008-3-25','2007-3-14'))
site<-c("abcejams.com", "reitimes.com", "posehbc")
desc1<-c("alpha", "beta", "gamma")
df1<-data.frame(date, site, desc1)

date2<-as.Date(c('2010-11-1','2008-3-25','2007-3-14', '2018-2-9'))
site2<-c("jams", "time", "pose", "abce")
metric2<-c(1,2,3,4)
metric3<-c(10,20,30,40)
df2<-data.frame(date2, site2, metric2, metric3)

Я написал функцию, которая определяет группы на основе обоих условий TRUE.

library(tidyverse)
library(stringr)

make_groups <- function(bicond) {
    lapply(apply(bicond, 1, function(i) which(i == 1)), function(i) if (length(i)==0) { NA } else { i })
}

custom_join <- function(df1, df2) {
    cond1 <- outer(df2$date2, df1$date, "==")
    cond2 <- outer(as.character(df2$site2), as.character(df1$site), function(i, j) str_detect(j, i))
    bicond <- cond1 * cond2
    data1 <- df1 %>% mutate(G = row_number())
    data2 <- df2 %>% mutate(G = make_groups(bicond)) %>% unnest(G)
    full_join(data2, data1, by=c("G" = "G", "date2" = "date")) %>% select(-G)
}

custom_join(df1, df2)

       # date2 site2 metric2 metric3         site desc1
# 1 2010-11-01  jams       1      10 abcejams.com alpha
# 2 2008-03-25  time       2      20 reitimes.com  beta
# 3 2007-03-14  pose       3      30      posehbc gamma
# 4 2018-02-09  abce       4      40         <NA>  <NA>

Другой пример

# new data
date<-as.Date(c('2010-11-1','2008-3-25','2007-3-14','2007-3-14'))
site<-c("abcejams.com", "reitimes.com", "posehbc", "poseur")
desc1<-c("alpha", "beta", "gamma", "epsilon")
df1<-data.frame(date, site, desc1)

date2<-as.Date(c('2010-11-1','2008-3-25','2007-3-14', '2007-2-9'))
site2<-c("jams", "time", "pose", "abce")
metric2<-c(1,2,3,4)
metric3<-c(10,20,30,40)
df2<-data.frame(date2, site2, metric2, metric3)

custom_join(df1, df2)

       # date2 site2 metric2 metric3         site   desc1
# 1 2010-11-01  jams       1      10 abcejams.com   alpha
# 2 2008-03-25  time       2      20 reitimes.com    beta
# 3 2007-03-14  pose       3      30      posehbc   gamma
# 4 2007-03-14  pose       3      30       poseur epsilon
# 5 2007-02-09  abce       4      40         <NA>    <NA>
person CPak    schedule 21.02.2018