ผสาน dataframes ตามหลายคอลัมน์และเกณฑ์

ฉันมีสองdata.frames มีคอลัมน์ร่วมกันหลาย ๆ (ที่นี่: date, city, ctryและ ( other_) number)

ตอนนี้ฉันต้องการรวมไว้ในคอลัมน์ด้านบน แต่ยอมรับระดับความแตกต่าง:

threshold.numbers <- 3
threshold.date <- 5  # in days

หากความแตกต่างระหว่างdateรายการคือ> threshold.date( เป็นวัน) หรือ > threshold.numbersฉันไม่ต้องการรวมบรรทัด ในทำนองเดียวกันถ้ารายการในcityเป็นสตริงย่อยของรายการอื่นdfในcityคอลัมน์ฉันต้องการให้บรรทัดถูกรวมเข้าด้วยกัน [ถ้าใครมีความคิดที่ดีในการทดสอบสำหรับชื่อเมืองที่เกิดขึ้นจริงคล้ายคลึงกันผมยินดีที่จะได้ยินเกี่ยวกับมัน.] (และให้คนแรกdfของรายการของdate, cityและcountryแต่ทั้งสอง ( other_) numberคอลัมน์และคอลัมน์อื่น ๆ dfทั้งหมดใน

ลองพิจารณาตัวอย่างต่อไปนี้:

df1 <- data.frame(date = c("2003-08-29", "1999-06-12", "2000-08-29", "1999-02-24", "2001-04-17",
                           "1999-06-30", "1999-03-16", "1999-07-16", "2001-08-29", "2002-07-30"),
                  city = c("Berlin", "Paris", "London", "Rome", "Bern",
                           "Copenhagen", "Warsaw", "Moscow", "Tunis", "Vienna"),
                  ctry = c("Germany", "France", "UK", "Italy", "Switzerland",
                           "Denmark", "Poland", "Russia", "Tunisia", "Austria"),
                  number = c(10, 20, 30, 40, 50, 60, 70, 80, 90, 100),
                  col = c("apple", "banana", "pear", "banana", "lemon", "cucumber", "apple", "peach", "cherry", "cherry"))


df2 <- data.frame(date = c("2003-08-29", "1999-06-12", "2000-08-29", "1999-02-24", "2001-04-17", # all identical to df1
                           "1999-06-29", "1999-03-14", "1999-07-17", # all 1-2 days different
                           "2000-01-29", "2002-07-01"), # all very different (> 2 weeks)
                  city = c("Berlin", "East-Paris", "near London", "Rome", # same or slight differences
                           "Zurich", # completely different
                           "Copenhagen", "Warsaw", "Moscow", "Tunis", "Vienna"), # same
                  ctry = c("Germany", "France", "UK", "Italy", "Switzerland", # all the same 
                           "Denmark", "Poland", "Russia", "Tunisia", "Austria"),
                  other_number = c(13, 17, 3100, 45, 51, 61, 780, 85, 90, 101), # slightly different to very different
                  other_col = c("yellow", "green", "blue", "red", "purple", "orange", "blue", "red", "black", "beige"))

ตอนนี้ฉันต้องการผสานdata.framesและรับdfบรรทัดที่รวมกันหากตรงตามเงื่อนไขข้างต้น

(คอลัมน์แรกมีไว้เพื่อความสะดวกของคุณเท่านั้น: หลังตัวเลขตัวแรกซึ่งแสดงถึงตัวพิมพ์ใหญ่มันจะแสดงว่าบรรทัดที่ผสาน ( .) หรือแสดงว่ามาจากdf1( 1) หรือdf2( 2)

          date        city        ctry number other_col other_number    other_col2          #comment
 1.  2003-08-29      Berlin     Germany     10     apple              13        yellow      # matched on date, city, number
 2.  1999-06-12       Paris      France     20    banana              17         green      # matched on date, city similar, number - other_number == threshold.numbers
 31  2000-08-29      London          UK     30      pear            <NA>          <NA>      # not matched: number - other_number > threshold.numbers
 32  2000-08-29 near London         UK    <NA>      <NA>            3100          blue      #
 41  1999-02-24        Rome       Italy     40    banana            <NA>          <NA>      # not matched: number - other_number > threshold.numbers
 42  1999-02-24        Rome       Italy   <NA>      <NA>              45           red      #
 51  2001-04-17        Bern Switzerland     50     lemon            <NA>          <NA>      # not matched: cities different (dates okay, numbers okay)
 52  2001-04-17      Zurich Switzerland   <NA>      <NA>              51        purple      #
 6.  1999-06-30  Copenhagen     Denmark     60  cucumber              61        orange      # matched: date difference < threshold.date (cities okay, dates okay)
 71  1999-03-16      Warsaw      Poland     70     apple            <NA>          <NA>      # not matched: number - other_number > threshold.numbers (dates okay)
 72  1999-03-14      Warsaw      Poland   <NA>      <NA>             780          blue      # 
 81  1999-07-16      Moscow      Russia     80     peach            <NA>          <NA>      # not matched: number - other_number > threshold.numbers (dates okay)
 82  1999-07-17      Moscow      Russia   <NA>      <NA>              85           red      #
 91  2001-08-29       Tunis     Tunisia     90    cherry            <NA>          <NA>      # not matched: date difference < threshold.date (cities okay, dates okay)
 92  2000-01-29       Tunis     Tunisia   <NA>      <NA>              90         black      #
101  2002-07-30      Vienna     Austria    100    cherry            <NA>          <NA>      # not matched: date difference < threshold.date (cities okay, dates okay)
102  2002-07-01      Vienna     Austria   <NA>      <NA>             101         beige      #

ฉันลองการใช้งานที่แตกต่างกันของการผสานพวกเขา แต่ไม่สามารถนำเกณฑ์ไปใช้

แก้ไข ขอโทษสำหรับสูตรที่ไม่ชัดเจน - ฉันต้องการเก็บแถวทั้งหมดและรับตัวบ่งชี้ว่าแถวนั้นตรงกันตรงกันหรือไม่และจาก df1 หรือไม่ตรงกันและจาก df2

รหัสหลอกคือ:

  if there is a case where abs("date_df2" - "date_df1") <= threshold.date:
    if "ctry_df2" == "ctry_df1":
      if "city_df2" ~ "city_df1":
        if abs("number_df2" - "number_df1") <= threshold.numbers:
          merge and go to next row in df2
  else:
    add row to df1```

นี่คือทางออกที่ใช้แพคเกจของฉันsafejoinห่อในกรณีนี้แพคเกจfuzzyjoin

เราสามารถใช้byอาร์กิวเมนต์เพื่อระบุเงื่อนไขที่ซับซ้อนโดยใช้ฟังก์ชั่นX()ที่จะได้รับความคุ้มค่าจากเขาdf1และจะได้รับค่าจากY()df2

หากตารางจริงของคุณมีขนาดใหญ่อาจเป็นไปได้ช้าหรือเป็นไปไม่ได้เหมือนกับผลิตภัณฑ์คาร์ทีเซียน แต่ที่นี่ใช้งานได้ดี

สิ่งที่เราต้องการคือการเข้าร่วมเต็มรูปแบบ (เก็บทุกแถวและเข้าร่วมในสิ่งที่สามารถเข้าร่วมได้) และเราต้องการเก็บค่าแรกเมื่อพวกเขาเข้าร่วมและนำสิ่งต่อไปที่ฉลาดอื่นมาใช้ซึ่งหมายความว่าเราต้องการจัดการกับความขัดแย้ง คอลัมน์ที่มีชื่อเหมือนกันโดยรวมกันดังนั้นเราจึงใช้อาร์กิวเมนต์ conflict = dplyr::coalesce

# remotes::install_github("moodymudskipper/safejoin")


# with provides inputs date is a factor, this will cause issues, so we need to
# convert either to date or character, character will do for now.
df1$date <- as.character(df1$date)
df2$date <- as.character(df2$date)

# we want our joining columns named the same to make them conflicted and use our
# conflict agument on conflicted paires
names(df2)[1:4] <- names(df1)[1:4]

library(safejoin)
safe_full_join(
  df1, df2,  
  by = ~ {
    # must convert every type because fuzzy join uses a matrix so coerces all inputs to character
    # see explanation at the bottom
    city1 <- X("city")
    city2 <- Y("city")
    date1 <- as.Date(X("date"), origin = "1970-01-01")
    date2 <- as.Date(Y("date"), origin = "1970-01-01")
    number1 <- as.numeric(X("number"))
    number2 <- as.numeric(Y("number"))
    # join if one city name contains the other
    (mapply(grepl, city1, city2) | mapply(grepl, city2, city1)) &
    # and dates are close enough (need to work in seconds because difftime is dangerous)
      abs(difftime(date1, date2, "sec")) <= threshold.date*3600*24 &
    # and numbers are close enough
      abs(number1 - number2) <= threshold.numbers
    },
  conflict = dplyr::coalesce)

ผลลัพธ์:

#>          date        city        ctry number      col other_col
#> 1  2003-08-29      Berlin     Germany     10    apple    yellow
#> 2  1999-06-12       Paris      France     20   banana     green
#> 3  1999-06-30  Copenhagen     Denmark     60 cucumber    orange
#> 4  2000-08-29      London          UK     30     pear      <NA>
#> 5  1999-02-24        Rome       Italy     40   banana      <NA>
#> 6  2001-04-17        Bern Switzerland     50    lemon      <NA>
#> 7  1999-03-16      Warsaw      Poland     70    apple      <NA>
#> 8  1999-07-16      Moscow      Russia     80    peach      <NA>
#> 9  2001-08-29       Tunis     Tunisia     90   cherry      <NA>
#> 10 2002-07-30      Vienna     Austria    100   cherry      <NA>
#> 11 2000-08-29 near London          UK   3100     <NA>      blue
#> 12 1999-02-24        Rome       Italy     45     <NA>       red
#> 13 2001-04-17      Zurich Switzerland     51     <NA>    purple
#> 14 1999-03-14      Warsaw      Poland    780     <NA>      blue
#> 15 1999-07-17      Moscow      Russia     85     <NA>       red
#> 16 2000-01-29       Tunis     Tunisia     90     <NA>     black
#> 17 2002-07-01      Vienna     Austria    101     <NA>     beige

^{สร้างเมื่อ 2019-11-13 โดยแพ็คเกจ reprex (v0.3.0)}

น่าเสียดายที่fuzzyjoin ทำการรวมคอลัมน์ทั้งหมดในเมทริกซ์เมื่อทำการรวมหลายครั้งและsafejoin จะล้อมรอบด้วยfuzzyjoinดังนั้นเราต้องแปลงตัวแปรให้เป็นประเภทที่เหมาะสมภายในbyอาร์กิวเมนต์

เพิ่มเติมเกี่ยวกับsafejoin : https://github.com/moodymudskipper/safejoin

ฉันเปลี่ยนชื่อเมืองเป็นเวกเตอร์อักขระเนื่องจาก (ถ้าฉันเข้าใจถูกต้อง) คุณต้องการรวมชื่อเมืองที่อยู่ใน df2

df1$city<-as.character(df1$city)
df2$city<-as.character(df2$city)

จากนั้นรวมประเทศ:

df = merge(df1, df2, by = ("ctry"))

> df
          ctry     date.x     city.x number      col     date.y      city.y other_number other_col
1      Austria 2002-07-30     Vienna    100   cherry 2002-07-01      Vienna          101     beige
2      Denmark 1999-06-30 Copenhagen     60 cucumber 1999-06-29  Copenhagen           61    orange
3       France 1999-06-12      Paris     20   banana 1999-06-12  East-Paris           17     green
4      Germany 2003-08-29     Berlin     10    apple 2003-08-29      Berlin           13    yellow
5        Italy 1999-02-24       Rome     40   banana 1999-02-24        Rome           45       red
6       Poland 1999-03-16     Warsaw     70    apple 1999-03-14      Warsaw          780      blue
7       Russia 1999-07-16     Moscow     80    peach 1999-07-17      Moscow           85       red
8  Switzerland 2001-04-17       Bern     50    lemon 2001-04-17      Zurich           51    purple
9      Tunisia 2001-08-29      Tunis     90   cherry 2000-01-29       Tunis           90     black
10          UK 2000-08-29     London     30     pear 2000-08-29 near London         3100      blue

ห้องสมุดstringrจะช่วยให้คุณดูว่า city.x อยู่ใน city.y ที่นี่ (ดูคอลัมน์สุดท้าย):

library(stringr)
df$city_keep<-str_detect(df$city.y,df$city.x) # this returns logical vector if city.x is contained in city.y (works one way)
> df
          ctry     date.x     city.x number      col     date.y      city.y other_number other_col city_keep
1      Austria 2002-07-30     Vienna    100   cherry 2002-07-01      Vienna          101     beige      TRUE
2      Denmark 1999-06-30 Copenhagen     60 cucumber 1999-06-29  Copenhagen           61    orange      TRUE
3       France 1999-06-12      Paris     20   banana 1999-06-12  East-Paris           17     green      TRUE
4      Germany 2003-08-29     Berlin     10    apple 2003-08-29      Berlin           13    yellow      TRUE
5        Italy 1999-02-24       Rome     40   banana 1999-02-24        Rome           45       red      TRUE
6       Poland 1999-03-16     Warsaw     70    apple 1999-03-14      Warsaw          780      blue      TRUE
7       Russia 1999-07-16     Moscow     80    peach 1999-07-17      Moscow           85       red      TRUE
8  Switzerland 2001-04-17       Bern     50    lemon 2001-04-17      Zurich           51    purple     FALSE
9      Tunisia 2001-08-29      Tunis     90   cherry 2000-01-29       Tunis           90     black      TRUE
10          UK 2000-08-29     London     30     pear 2000-08-29 near London         3100      blue      TRUE

จากนั้นคุณสามารถรับความแตกต่างในวันระหว่างวันที่:

df$dayDiff<-abs(as.POSIXlt(df$date.x)$yday - as.POSIXlt(df$date.y)$yday)

และความแตกต่างของตัวเลข:

df$numDiff<-abs(df$number - df$other_number)

นี่คือลักษณะของดาต้าเฟรมที่เกิดขึ้น:

> df
          ctry     date.x     city.x number      col     date.y      city.y other_number other_col city_keep dayDiff numDiff
1      Austria 2002-07-30     Vienna    100   cherry 2002-07-01      Vienna          101     beige      TRUE      29       1
2      Denmark 1999-06-30 Copenhagen     60 cucumber 1999-06-29  Copenhagen           61    orange      TRUE       1       1
3       France 1999-06-12      Paris     20   banana 1999-06-12  East-Paris           17     green      TRUE       0       3
4      Germany 2003-08-29     Berlin     10    apple 2003-08-29      Berlin           13    yellow      TRUE       0       3
5        Italy 1999-02-24       Rome     40   banana 1999-02-24        Rome           45       red      TRUE       0       5
6       Poland 1999-03-16     Warsaw     70    apple 1999-03-14      Warsaw          780      blue      TRUE       2     710
7       Russia 1999-07-16     Moscow     80    peach 1999-07-17      Moscow           85       red      TRUE       1       5
8  Switzerland 2001-04-17       Bern     50    lemon 2001-04-17      Zurich           51    purple     FALSE       0       1
9      Tunisia 2001-08-29      Tunis     90   cherry 2000-01-29       Tunis           90     black      TRUE     212       0
10          UK 2000-08-29     London     30     pear 2000-08-29 near London         3100      blue      TRUE       0    3070

แต่เราต้องการวางสิ่งที่ไม่พบ city.x ภายใน city.y โดยที่ความแตกต่างของวันมากกว่า 5 หรือความแตกต่างของตัวเลขมากกว่า 3:

df<-df[df$dayDiff<=5 & df$numDiff<=3 & df$city_keep==TRUE,]

> df
     ctry     date.x     city.x number      col     date.y     city.y other_number other_col city_keep dayDiff numDiff
2 Denmark 1999-06-30 Copenhagen     60 cucumber 1999-06-29 Copenhagen           61    orange      TRUE       1       1
3  France 1999-06-12      Paris     20   banana 1999-06-12 East-Paris           17     green      TRUE       0       3
4 Germany 2003-08-29     Berlin     10    apple 2003-08-29     Berlin           13    yellow      TRUE       0       3

สิ่งที่เหลืออยู่คือสามแถวที่คุณมีด้านบน (ซึ่งมีจุดในคอลัมน์ 1)

ตอนนี้เราสามารถวางสามคอลัมน์ที่เราสร้างขึ้นและวันที่และเมืองจาก df2:

> df<-subset(df, select=-c(city.y, date.y, city_keep, dayDiff, numDiff))
> df
     ctry     date.x     city.x number      col other_number other_col
2 Denmark 1999-06-30 Copenhagen     60 cucumber           61    orange
3  France 1999-06-12      Paris     20   banana           17     green
4 Germany 2003-08-29     Berlin     10    apple           13    yellow

ขั้นตอนที่ 1: รวมข้อมูลตาม "เมือง" และ "ctry":

df = merge(df1, df2, by = c("city", "ctry"))

ขั้นตอนที่ 2: ลบแถวออกหากความแตกต่างระหว่างรายการวันที่คือ> threshold.date (เป็นวัน):

date_diff = abs(as.numeric(difftime(strptime(df$date.x, format = "%Y-%m-%d"),
                                    strptime(df$date.y, format = "%Y-%m-%d"), units="days")))
index_remove = date_diff > threshold.date
df = df[-index_remove,]

ขั้นตอนที่ 3: ลบแถวหากความแตกต่างระหว่างตัวเลขคือ> threshhold.number:

number_diff = abs(df$number - df$other_number) 
index_remove = number_diff > threshold.numbers
df = df[-index_remove,]

ควรผสานข้อมูลก่อนใช้เงื่อนไขในกรณีที่แถวไม่ตรงกัน

ตัวเลือกที่ใช้data.table(คำอธิบายแบบอินไลน์):

library(data.table)
setDT(df1)
setDT(df2)

#dupe columns and create ranges for non-equi joins
df1[, c("n", "ln", "un", "d", "ld", "ud") := .(
    number, number - threshold.numbers, number + threshold.numbers,
    date, date - threshold.date, date + threshold.date)]
df2[, c("n", "ln", "un", "d", "ld", "ud") := .(
    other_number, other_number - threshold.numbers, other_number + threshold.numbers,
    date, date - threshold.date, date + threshold.date)]

#perform non-equi join using ctry, num, dates in both ways
res <- rbindlist(list(
    df1[df2, on=.(ctry, n>=ln, n<=un, d>=ld, d<=ud),
        .(date1=x.date, date2=i.date, city1=x.city, city2=i.city, ctry1=x.ctry, ctry2=i.ctry, number, col, other_number, other_col)],
    df2[df1, on=.(ctry, n>=ln, n<=un, d>=ld, d<=ud),
        .(date1=i.date, date2=x.date, city1=i.city, city2=x.city, ctry1=i.ctry, ctry2=x.ctry, number, col, other_number, other_col)]),
    use.names=TRUE, fill=TRUE)

#determine if cities are substrings of one and another
res[, city_match := {
    i <- mapply(grepl, city1, city2) | mapply(grepl, city2, city1)
    replace(i, is.na(i), TRUE)
}]

#just like SQL coalesce (there is a version in dev in rdatatable github)
coalesce <- function(...) Reduce(function(x, y) fifelse(!is.na(y), y, x), list(...))

#for rows that are matching or no matches to be found
ans1 <- unique(res[(city_match), .(date=coalesce(date1, date2),
    city=coalesce(city1, city2),
    ctry=coalesce(ctry1, ctry2),
    number, col, other_number, other_col)])

#for rows that are close in terms of dates and numbers but are diff cities
ans2 <- res[(!city_match), .(date=c(.BY$date1, .BY$date2),
        city=c(.BY$city1, .BY$city2),
        ctry=c(.BY$ctry1, .BY$ctry2),
        number=c(.BY$number, NA),
        col=c(.BY$col, NA),
        other_number=c(NA, .BY$other_number),
        other_col=c(NA, .BY$other_col)),
    names(res)][, seq_along(names(res)) := NULL]

#final desired output
setorder(rbindlist(list(ans1, ans2)), date, city, number, na.last=TRUE)[]

เอาท์พุท:

          date        city        ctry number      col other_number other_col
 1: 1999-02-24        Rome       Italy     40   banana           NA      <NA>
 2: 1999-02-24        Rome       Italy     NA     <NA>           45       red
 3: 1999-03-14      Warsaw      Poland     NA     <NA>          780      blue
 4: 1999-03-16      Warsaw      Poland     70    apple           NA      <NA>
 5: 1999-06-12  East-Paris      France     20   banana           17     green
 6: 1999-06-29  Copenhagen     Denmark     60 cucumber           61    orange
 7: 1999-07-16      Moscow      Russia     80    peach           NA      <NA>
 8: 1999-07-17      Moscow      Russia     NA     <NA>           85       red
 9: 2000-01-29       Tunis     Tunisia     NA     <NA>           90     black
10: 2000-08-29      London          UK     30     pear           NA      <NA>
11: 2000-08-29 near London          UK     NA     <NA>         3100      blue
12: 2001-04-17        Bern Switzerland     50    lemon           NA      <NA>
13: 2001-04-17      Zurich Switzerland     NA     <NA>           51    purple
14: 2001-08-29       Tunis     Tunisia     90   cherry           NA      <NA>
15: 2002-07-01      Vienna     Austria     NA     <NA>          101     beige
16: 2002-07-30      Vienna     Austria    100   cherry           NA      <NA>
17: 2003-08-29      Berlin     Germany     10    apple           13    yellow

คุณสามารถทดสอบcityการแข่งขันด้วยgreplและเรียบง่ายด้วยctry ==สำหรับผู้ที่ตรงกับความจนที่นี่คุณสามารถคำนวณความแตกต่างวันที่โดยการแปลงdateใช้และเปรียบเทียบกับas.Date difftimeความnumberแตกต่างก็ทำแบบเดียวกัน

i1 <- seq_len(nrow(df1)) #Store all rows 
i2 <- seq_len(nrow(df2))
res <- do.call(rbind, sapply(seq_len(nrow(df1)), function(i) { #Loop over all rows in df1
  t1 <- which(df1$ctry[i] == df2$ctry) #Match ctry
  t2 <- grepl(df1$city[i], df2$city[t1]) | sapply(df2$city[t1], grepl, df1$city[i]) #Match city
  t1 <- t1[t2 & abs(as.Date(df1$date[i]) - as.Date(df2$date[t1[t2]])) <=
    as.difftime(threshold.date, units = "days") & #Test for date difference
    abs(df1$number[i] - df2$other_number[t1[t2]]) <= threshold.numbers] #Test for number difference
  if(length(t1) > 0) { #Match found
    i1 <<- i1[i1!=i] #Remove row as it was found
    i2 <<- i2[i2!=t1]
    cbind(df1[i,], df2[t1,c("other_number","other_col")], match=".") 
  }
}))
rbind(res
    , cbind(df1[i1,], other_number=NA, other_col=NA, match="1")
    , cbind(df2[i2,1:3], number=NA, col=NA, other_number=df2[i2,4]
            , other_col=df2[i2,5], match="2"))
#          date        city        ctry number      col other_number other_col match
#1   2003-08-29      Berlin     Germany     10    apple           13    yellow     .
#2   1999-06-12       Paris      France     20   banana           17     green     .
#6   1999-06-30  Copenhagen     Denmark     60 cucumber           61    orange     .
#3   2000-08-29      London          UK     30     pear           NA      <NA>     1
#4   1999-02-24        Rome       Italy     40   banana           NA      <NA>     1
#5   2001-04-17        Bern Switzerland     50    lemon           NA      <NA>     1
#7   1999-03-16      Warsaw      Poland     70    apple           NA      <NA>     1
#8   1999-07-16      Moscow      Russia     80    peach           NA      <NA>     1
#9   2001-08-29       Tunis     Tunisia     90   cherry           NA      <NA>     1
#10  2002-07-30      Vienna     Austria    100   cherry           NA      <NA>     1
#31  2000-08-29 near London          UK     NA     <NA>         3100      blue     2
#41  1999-02-24        Rome       Italy     NA     <NA>           45       red     2
#51  2001-04-17      Zurich Switzerland     NA     <NA>           51    purple     2
#71  1999-03-14      Warsaw      Poland     NA     <NA>          780      blue     2
#81  1999-07-17      Moscow      Russia     NA     <NA>           85       red     2
#91  2000-01-29       Tunis     Tunisia     NA     <NA>           90     black     2
#101 2002-07-01      Vienna     Austria     NA     <NA>          101     beige     2

นี่คือวิธีการที่ยืดหยุ่นที่ช่วยให้คุณระบุคอลเลกชันของเกณฑ์การผสานที่คุณเลือก

เตรียมงาน

ฉันรับรองว่าสตริงทั้งหมดdf1และdf2เป็นสตริงไม่ใช่ปัจจัย (ดังที่ระบุไว้ในคำตอบอื่น ๆ ) ฉันยังใส่วันที่as.Dateเพื่อให้เป็นวันที่ที่แท้จริง

ระบุเกณฑ์การผสาน

สร้างรายการของรายการ แต่ละองค์ประกอบของรายการหลักคือหนึ่งเกณฑ์ สมาชิกของเกณฑ์คือ

• final.col.name: ชื่อของคอลัมน์ที่เราต้องการในตารางสุดท้าย
• col.name.1: ชื่อของคอลัมน์ใน df1
• col.name.2: ชื่อของคอลัมน์ใน df2
• exact: บูลีน; เราควรทำการจับคู่ที่แน่นอนในคอลัมน์นี้หรือไม่
• threshold: threshold (หากเราไม่ได้จับคู่แบบตรงทั้งหมด)
• match.function: ฟังก์ชันที่คืนค่าว่าแถวตรงกันหรือไม่ (สำหรับกรณีพิเศษเช่นใช้greplสำหรับการจับคู่สตริงโปรดทราบว่าฟังก์ชันนี้จะต้องเป็นแบบเวกเตอร์)

merge.criteria = list(
  list(final.col.name = "date",
       col.name.1 = "date",
       col.name.2 = "date",
       exact = F,
       threshold = 5),
  list(final.col.name = "city",
       col.name.1 = "city",
       col.name.2 = "city",
       exact = F,
       match.function = function(x, y) {
         return(mapply(grepl, x, y) |
                  mapply(grepl, y, x))
       }),
  list(final.col.name = "ctry",
       col.name.1 = "ctry",
       col.name.2 = "ctry",
       exact = T),
  list(final.col.name = "number",
       col.name.1 = "number",
       col.name.2 = "other_number",
       exact = F,
       threshold = 3)
)

ฟังก์ชั่นสำหรับการรวม

ฟังก์ชันนี้ใช้เวลาสามข้อโต้แย้ง: สองเฟรมข้อมูลที่เราต้องการผสานและรายการเกณฑ์การจับคู่ มันดำเนินการดังต่อไปนี้:

1. วนซ้ำตามเกณฑ์การจับคู่และพิจารณาว่าคู่แถวใดทำหรือไม่ตรงตามเกณฑ์ทั้งหมด (ได้แรงบันดาลใจจากคำตอบของ @ GKi จะใช้ดัชนีแถวแทนการเข้าร่วมเต็มรูปแบบภายนอกซึ่งอาจใช้หน่วยความจำน้อยกว่าสำหรับชุดข้อมูลขนาดใหญ่)
2. สร้างเฟรมข้อมูล Skeleton ที่มีเพียงแถวที่เราต้องการ (แถวที่ถูกรวมในกรณีของการจับคู่, แถวที่แยกจากกันสำหรับระเบียนที่ไม่ตรงกัน)
3. ทำซ้ำผ่านคอลัมน์ของเฟรมข้อมูลดั้งเดิมและใช้เพื่อเติมคอลัมน์ที่ต้องการในกรอบข้อมูลใหม่ (ทำสิ่งนี้ก่อนสำหรับคอลัมน์ที่ปรากฏในเกณฑ์การจับคู่และคอลัมน์อื่น ๆ ที่เหลือ)

library(dplyr)
merge.data.frames = function(df1, df2, merge.criteria) {
  # Create a data frame with all possible pairs of rows from df1 and rows from
  # df2.
  row.decisions = expand.grid(df1.row = 1:nrow(df1), df2.row = 1:nrow(df2))
  # Iterate over the criteria in merge.criteria.  For each criterion, flag row
  # pairs that don't meet the criterion.
  row.decisions$merge = T
  for(criterion in merge.criteria) {
    # If we're looking for an exact match, test for equality.
    if(criterion$exact) {
      row.decisions$merge = row.decisions$merge &
        df1[row.decisions$df1.row,criterion$col.name.1] == df2[row.decisions$df2.row,criterion$col.name.2]
    }
    # If we're doing a threshhold test, test for difference.
    else if(!is.null(criterion$threshold)) {
      row.decisions$merge = row.decisions$merge &
        abs(df1[row.decisions$df1.row,criterion$col.name.1] - df2[row.decisions$df2.row,criterion$col.name.2]) <= criterion$threshold
    }
    # If the user provided a function, use that.
    else if(!is.null(criterion$match.function)) {
      row.decisions$merge = row.decisions$merge &
        criterion$match.function(df1[row.decisions$df1.row,criterion$col.name.1],
                                 df2[row.decisions$df2.row,criterion$col.name.2])
    }
  }
  # Create the new dataframe.  Just row numbers of the source dfs to start.
  new.df = bind_rows(
    # Merged rows.
    row.decisions %>% filter(merge) %>% select(-merge),
    # Rows from df1 only.
    row.decisions %>% group_by(df1.row) %>% summarize(matches = sum(merge)) %>% filter(matches == 0) %>% select(df1.row),
    # Rows from df2 only.
    row.decisions %>% group_by(df2.row) %>% summarize(matches = sum(merge)) %>% filter(matches == 0) %>% select(df2.row)
  )
  # Iterate over the merge criteria and add columns that were used for matching
  # (from df1 if available; otherwise from df2).
  for(criterion in merge.criteria) {
    new.df[criterion$final.col.name] = coalesce(df1[new.df$df1.row,criterion$col.name.1],
                                                df2[new.df$df2.row,criterion$col.name.2])
  }
  # Now add all the columns from either data frame that weren't used for
  # matching.
  for(other.col in setdiff(colnames(df1),
                           sapply(merge.criteria, function(x) x$col.name.1))) {
    new.df[other.col] = df1[new.df$df1.row,other.col]
  }
  for(other.col in setdiff(colnames(df2),
                           sapply(merge.criteria, function(x) x$col.name.2))) {
    new.df[other.col] = df2[new.df$df2.row,other.col]
  }
  # Return the result.
  return(new.df)
}

ใช้ฟังก์ชั่นและเราเสร็จแล้ว

df = merge.data.frames(df1, df2, merge.criteria)