Zusammenführen von Datenrahmen basierend auf mehreren Spalten und Schwellenwerten


11

Ich habe zwei data.frames mit mehreren gemeinsamen Spalten (hier: date, city, ctry, und ( other_) number).

Ich möchte sie jetzt in den obigen Spalten zusammenführen, aber einen gewissen Unterschied tolerieren:

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

Wenn der Unterschied zwischen den dateEinträgen > threshold.date(in Tagen) oder ist > threshold.numbers , möchte ich nicht, dass die Zeilen zusammengeführt werden. Wenn der Eintrag in cityeine Teilzeichenfolge des Eintrags des anderen dfin der citySpalte ist, möchte ich, dass die Zeilen zusammengeführt werden. [Wenn jemand eine bessere Idee zu Test für die tatsächlichen Stadtnamen hat Ähnlichkeit, würde ich gerne davon hören.] (Und halten Sie die ersten df‚s Einträge date, cityund countrydoch beide ( other_) numberSpalten und alle andere Spalten in der df.

Betrachten Sie das folgende Beispiel:

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"))

Jetzt möchte ich die zusammenführen data.framesund erhalten, dfwo Zeilen zusammengeführt werden, wenn die oben genannten Bedingungen erfüllt sind.

(Die erste Spalte dient nur der Übersichtlichkeit: Hinter der ersten Ziffer, die den ursprünglichen Fall angibt, wird angezeigt, ob die Zeilen zusammengeführt wurden ( .) oder ob die Zeilen von df1( 1) oder df2( 2) stammen.

          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      #

Ich habe verschiedene Implementierungen zum Zusammenführen versucht, kann aber den Schwellenwert nicht implementieren.

EDIT Entschuldigung für unklare Formulierung - Ich möchte alle Zeilen behalten und einen Indikator erhalten, ob die Zeile übereinstimmt, nicht übereinstimmt und von df1 oder nicht übereinstimmt und von df2.

Der Pseudocode lautet:

  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```

2
Ist dieser letzte Datenrahmen, den Sie gedruckt haben, die Ausgabe, die Sie erhalten möchten? dh sollte es am Ende 17 Zeilen geben? Oder nur die 3 mit einem markiert .?
Camille

Ich möchte eigentlich, dass alle Zeilen erhalten bleiben, aber mit einem Indikator, wenn sie übereinstimmen. Entschuldigung, wenn dies unklar war; Ich habe die Frage entsprechend bearbeitet.
Ivo

Das heißt also, Sie möchten 10 Zeilen wie das Original?
Camille

Ich habe Pseudocode hinzugefügt, um es klarer zu machen. Hilft das?
Ivo

Ich würde data.table wärmstens empfehlen, wenn data.frame nicht Ihre einzige Option ist
Kevin Ho

Antworten:


3

Hier ist eine Lösung, die mein Paket safejoin verwendet und in diesem Fall das Paket fuzzyjoin umschließt .

Wir können das byArgument verwenden, um eine komplexe Bedingung anzugeben, indem wir die Funktion verwenden X(), um den Wert von df1und Y()den Wert von zu erhaltendf2 .

Wenn Ihre echten Tische groß sind, kann dies langsam oder unmöglich sein, da es sich um ein kartesisches Produkt handelt, aber hier funktioniert es gut.

Was wir wollen, ist eine vollständige Verknüpfung (behalten Sie alle Zeilen bei und verbinden Sie, was verbunden werden kann), und wir möchten den ersten Wert behalten, wenn sie verbunden werden, und den nächsten anderen Wert. Dies bedeutet, dass wir uns mit dem Konflikt von befassen möchten Spalten, die durch Zusammenführen identisch benannt wurden, verwenden wir daher das Argument 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)

Ausgabe :

#>          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

Erstellt am 2019-11-13 vom reprex-Paket (v0.3.0)

Leider fuzzyjoin alle Spalten in einer Matrix nötigt , wenn ein Multi tun beizutreten, und safejoin Wraps fuzzyjoin , so dass wir die Variablen in den entsprechenden Typ innerhalb der durch das Argument konvertieren muss, erklärt dies die ersten Zeilen in derby Argument.

Weitere Informationen zu safejoin : https://github.com/moodymudskipper/safejoin


6

Ich habe zuerst die Städtenamen in Zeichenvektoren umgewandelt, da Sie (wenn ich das richtig verstanden habe) Stadtnamen einschließen möchten, die in df2 enthalten sind.

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

Dann führen Sie sie nach Ländern zusammen:

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

In der Bibliothek stringrkönnen Sie sehen, ob sich city.x in city.y befindet (siehe letzte Spalte):

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

Dann können Sie die Differenz in Tagen zwischen Daten erhalten:

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

und der Unterschied in Zahlen:

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

So sieht der resultierende Datenrahmen aus:

> 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

Wir möchten jedoch Dinge löschen, bei denen city.x nicht in city.y gefunden wurde, bei denen der Tagesunterschied größer als 5 oder der Zahlenunterschied größer als 3 ist:

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

Was bleibt, sind die drei Zeilen, die Sie oben hatten (die Punkte in Spalte 1 enthielten).

Jetzt können wir die drei von uns erstellten Spalten sowie das Datum und die Stadt aus df2 löschen:

> 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

5

Schritt 1: Führen Sie die Daten basierend auf "Stadt" und "Land" zusammen:

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

Schritt 2: Entfernen Sie Zeilen, wenn der Unterschied zwischen den Datumseinträgen> Schwellwert.Datum (in Tagen) ist:

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,]

Schritt 3: Entfernen Sie Zeilen, wenn der Unterschied zwischen den Zahlen> Schwellwert.Nummer ist:

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

Die Daten sollten vor dem Anwenden von Bedingungen zusammengeführt werden, falls die Zeilen nicht übereinstimmen.


3

Eine Option mit data.table(Erklärungen inline):

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)[]

Ausgabe:

          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

3

Sie können das cityMatch mit greplund ctryeinfach mit testen ==. Für diejenigen , die bis hier passen können Sie das Datum Differenz durch Umwandlung berechnen dateverwenden as.Dateund einen Vergleich mit ein difftime. Der numberUnterschied wird auf die gleiche Weise gemacht.

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

2

Hier ist ein flexibler Ansatz, mit dem Sie eine beliebige Sammlung von Zusammenführungskriterien angeben können, die Sie auswählen.

Vorbereitungsarbeit

Ich habe dafür gesorgt, dass alle Zeichenfolgen in df1und df2Zeichenfolgen waren, keine Faktoren (wie in einigen der anderen Antworten angegeben). Ich habe auch die Daten eingewickelt as.Date, um sie zu echten Daten zu machen.

Geben Sie die Zusammenführungskriterien an

Erstellen Sie eine Liste mit Listen. Jedes Element der Hauptliste ist ein Kriterium; Die Mitglieder eines Kriteriums sind

  • final.col.name: Der Name der Spalte, die wir in der Final Table haben möchten
  • col.name.1: der Name der Spalte in df1
  • col.name.2: der Name der Spalte in df2
  • exact: boolean; sollten wir diese Spalte genau abgleichen?
  • threshold: Schwelle (wenn wir nicht genau übereinstimmen)
  • match.function: Eine Funktion, die zurückgibt, ob die Zeilen übereinstimmen oder nicht (für spezielle Fälle wie die Verwendung greplfür die Zeichenfolgenübereinstimmung; beachten Sie, dass diese Funktion vektorisiert werden muss ).
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)
)

Funktion zum Zusammenführen

Diese Funktion verwendet drei Argumente: die beiden Datenrahmen, die zusammengeführt werden sollen, und die Liste der Übereinstimmungskriterien. Es geht wie folgt vor:

  1. Durchlaufen Sie die Übereinstimmungskriterien und bestimmen Sie, welche Zeilenpaare alle Kriterien erfüllen oder nicht. (Inspiriert von der Antwort von @ GKi werden Zeilenindizes verwendet, anstatt eine vollständige äußere Verknüpfung durchzuführen, was bei großen Datenmengen möglicherweise weniger speicherintensiv ist.)
  2. Erstellen Sie einen Skelettdatenrahmen mit nur den gewünschten Zeilen (zusammengeführte Zeilen bei Übereinstimmungen, nicht zusammengeführte Zeilen für nicht übereinstimmende Datensätze).
  3. Durchlaufen Sie die Spalten der ursprünglichen Datenrahmen und füllen Sie damit die gewünschten Spalten im neuen Datenrahmen. (Führen Sie dies zuerst für die Spalten aus, die in den Übereinstimmungskriterien angezeigt werden, und dann für alle anderen verbleibenden Spalten.)
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)
}

Wenden Sie die Funktion an, und wir sind fertig

df = merge.data.frames(df1, df2, merge.criteria)
Durch die Nutzung unserer Website bestätigen Sie, dass Sie unsere Cookie-Richtlinie und Datenschutzrichtlinie gelesen und verstanden haben.
Licensed under cc by-sa 3.0 with attribution required.