根据多个列和阈值合并数据帧

时间:2019-11-05 16:49:35

标签: r dataframe

我有两个data.frame,其中有多个公共列(在这里:datecityctry和(other_number )。

我现在想将它们合并到上面的列中,但可以容忍某种程度的差异:

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

如果date项之间的差是> threshold.date(以天为单位) > threshold.numbers,则我不希望合并这些行。 同样,如果city中的条目是df列中其他city条目的子字符串,我希望合并这些行。 [如果有人有更好的主意来测试实际城市名称的相似性,我很乐意听到。](并保留df,{{1的前date个条目}}和city,但{{1}的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.df11)。

df2

我尝试了将它们合并的不同实现,但是无法实现阈值。

编辑 对于不清楚的表述表示歉意-我想保留所有行,并接收一个指示符,该行是df1匹配,不匹配还是df2不匹配。

伪代码为:

2

6 个答案:

答案 0 :(得分:6)

我首先将城市名称转换为字符向量,因为(如果我理解正确的话)您想包括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.y中找不到city.x的地方,其中日期差大于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

剩下的是您上面的三行(第一列中包含点)。

现在,我们可以删除创建的三列以及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 :(得分:5)

第1步:根据“城市”和“哭泣”合并数据:

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

在应用条件之前,应合并数据,以防行不匹配。

答案 2 :(得分:3)

您可以使用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

答案 3 :(得分:3)

这是使用我的软件包 safejoin 的解决方案,在这种情况下,包装为 fuzzyjoin 软件包。

我们可以使用by参数来指定复杂的条件,使用函数X()df1获取值,并使用Y()从{ {1}}。

如果您的真实表很大,那么这可能会很慢,甚至不可能像笛卡尔积一样进行操作,但是在这里效果很好。

我们想要的是完全连接(保留所有行,并连接可以连接的内容),并且我们希望在连接时保留第一个值,并明智地使用下一个,这意味着我们要处理通过合并而具有相同名称的列的冲突,因此我们使用参数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)

reprex package(v0.3.0)于2019-11-13创建

不幸的是, fuzzyjoin 在进行多联接时会强制转换矩阵中的所有列,而 safejoin 包装了 fuzzyjoin ,因此我们必须将变量转换为by参数中的适当类型,这说明了#> 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 参数中的第一行。

有关 safejoin 的更多信息:https://github.com/moodymudskipper/safejoin

答案 4 :(得分:2)

使用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

答案 5 :(得分:2)

这是一种灵活的方法,可让您指定选择的任何合并条件集合。

预备工作

我确保df1df2中的所有字符串都是字符串,而不是因素(如其他几个答案所述)。我还把日期包装在as.Date中,使它们成为真实日期。

指定合并条件

创建列表列表。主列表中的每个元素都是一个条件。条件的成员是

  • final.col.name:最终表中我们想要的列的名称
  • col.name.1df1中的列名
  • col.name.2df2中的列名
  • exact:布尔值;我们应该在此列上进行完全匹配吗?
  • 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. 仅用所需的行创建骨架数据框(在匹配的情况下合并行,在不匹配的记录中合并行)。
  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)