fusionar marcos de datos basados ​​en múltiples columnas y umbrales


11

Tengo dos data.frames con múltiples columnas comunes (en este caso date, city, ctry, y ( other_) number).

Ahora me gustaría fusionarlos en las columnas anteriores, pero tolero algún nivel de diferencia:

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

Si la diferencia entre las dateentradas es > threshold.date(en días) o > threshold.numbers , no quiero que las líneas se fusionen. Del mismo modo, si la entrada en cityes una subcadena de la dfentrada del otro en la citycolumna, quiero que las líneas se fusionen. [Si alguien tiene una mejor idea para probar la similitud de los nombres de ciudades reales, me alegraría saberlo.] (Y mantenga las primeras dfentradas de date, cityy countryambas ( other_) numbercolumnas y todas las demás columnas en df.

Considere el siguiente ejemplo:

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

Ahora, me gustaría fusionar data.framesy recibir un dfdonde las líneas se fusionan si se cumplen las condiciones anteriores.

(La primera columna es solo para su conveniencia: detrás del primer dígito, que indica el caso original, muestra si las líneas se fusionaron ( .) o si las líneas son de df1( 1) o 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      #

Intenté diferentes implementaciones para fusionarlas, pero no puedo implementar el umbral.

EDITAR Disculpas por una formulación poco clara: me gustaría conservar todas las filas y recibir un indicador de si la fila coincide, no coincide y de df1 o no coincide y de df2.

el pseudocódigo es:

  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
¿Es este último marco de datos que imprimiste la salida que quieres obtener? es decir, debe haber 17 filas al final? ¿O solo los 3 marcados con un .?
camille

De hecho, quiero que todas las filas se conserven, pero con un indicador si coinciden. Lo siento si esto no estaba claro; Edité la pregunta en consecuencia.
Ivo

¿Eso significa que quieres 10 filas como la original?
camille

Agregué un pseudo código para hacerlo más claro; ¿esto ayuda?
Ivo

Yo sugeriría data.table si hoja.de.datos no es su única opción
Kevin Ho

Respuestas:


3

Aquí hay una solución que utiliza mi paquete safejoin , envolviendo en este caso el paquete fuzzyjoin .

Podemos usar el byargumento para especificar una condición compleja, usando la función X()para obtener el valor df1y Y()obtener el valor df2.

Si sus tablas reales son grandes, esto podría ser lento o imposible como lo hace un producto cartesiano, pero aquí funciona bien.

Lo que queremos es una unión completa (mantener todas las filas y unir lo que se puede unir), y queremos mantener el primer valor cuando se unen, y tomar el siguiente de otra manera, esto significa que queremos lidiar con el conflicto de columnas nombradas idénticamente por fusión, por lo que usamos el argumento 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)

salida:

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

Creado el 13/11/2019 por el paquete reprex (v0.3.0)

Desafortunadamente, fuzzyjoin obliga a todas las columnas de una matriz al hacer una unión múltiple, y safejoin ajusta fuzzyjoin, por lo que debemos convertir las variables al tipo apropiado dentro del argumento by, esto explica las primeras líneas del byargumento.

Más sobre safejoin : https://github.com/moodymudskipper/safejoin


6

Primero convertí los nombres de las ciudades en vectores de caracteres, ya que (si entendí correctamente) desea incluir los nombres de ciudades que figuran en df2.

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

Luego fusionarlos por país:

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

La biblioteca stringrle permitirá ver si city.x está dentro de city.y aquí (vea la última columna):

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

Entonces puede obtener la diferencia en días entre fechas:

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

y la diferencia en números:

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

Así es como se ve el marco de datos resultante:

> 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

Pero queremos descartar cosas donde city.x no se encontró dentro de city.y, donde la diferencia de días es mayor que 5 o la diferencia numérica es mayor que 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

Lo que queda son las tres filas que tenía arriba (que contenían puntos en la columna 1).

Ahora podemos soltar las tres columnas que creamos, y la fecha y la ciudad de 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

5

Paso 1: fusionar los datos en función de "ciudad" y "ctry":

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

Paso 2: elimine las filas si la diferencia entre las entradas de fecha es> umbral.fecha (en días):

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

Paso 3: elimine las filas si la diferencia entre los números es> threshhold.number:

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

Los datos deben fusionarse antes de aplicar condiciones, en caso de que las filas no coincidan.


3

Una opción usando data.table(explicaciones en línea):

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

salida:

          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

Puede probar el citypartido con greply ctrysimple con ==. Para aquellos que coinciden hasta aquí, puede calcular la diferencia de fecha convirtiéndola al dateuso as.Datey comparándola con a difftime. La numberdiferencia se hace de la misma manera.

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

Aquí hay un enfoque flexible que le permite especificar cualquier colección de criterios de fusión que elija.

Trabajo de preparación

Me aseguré de que todas las cuerdas en df1y df2fuera cadenas, no los factores (como se ha señalado en varias de las otras respuestas). También envolví las fechas as.Datepara convertirlas en fechas reales.

Especificar los criterios de fusión

Crea una lista de listas. Cada elemento de la lista principal es un criterio; los miembros de un criterio son

  • final.col.name: el nombre de la columna que queremos en la tabla final
  • col.name.1: el nombre de la columna en df1
  • col.name.2: el nombre de la columna en df2
  • exact: booleano; ¿Deberíamos hacer una coincidencia exacta en esta columna?
  • threshold: umbral (si no estamos haciendo coincidencia exacta)
  • match.function: una función que devuelve si las filas coinciden o no (para casos especiales como el uso greplpara la coincidencia de cadenas; tenga en cuenta que esta función debe ser vectorizada)
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)
)

Función para fusionar

Esta función toma tres argumentos: los dos marcos de datos que queremos fusionar y la lista de criterios de coincidencia. Se procede de la siguiente manera:

  1. Repite los criterios de coincidencia y determina qué pares de filas cumplen o no todos los criterios. (Inspirado por la respuesta de @ GKi, utiliza índices de fila en lugar de hacer una unión externa completa, que puede requerir menos memoria para grandes conjuntos de datos).
  2. Cree un marco de datos esqueleto con solo las filas que queremos (filas combinadas en el caso de coincidencias, filas no combinadas para registros no coincidentes).
  3. Itere a través de las columnas de los marcos de datos originales y utilícelos para llenar las columnas deseadas en el nuevo marco de datos. (Haga esto primero para las columnas que aparecen en los criterios de coincidencia, y luego para cualquier otra columna que quede).
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)
}

Aplica la función, y terminamos

df = merge.data.frames(df1, df2, merge.criteria)
Al usar nuestro sitio, usted reconoce que ha leído y comprende nuestra Política de Cookies y Política de Privacidad.
Licensed under cc by-sa 3.0 with attribution required.