在数据名2中找到数据框1的紧密匹配

问题描述 投票：0回答：1

我有两个数据框，对于数据框一中的每个特定行，我试图根据定义的重要标准（班次、年龄、级别）从数据框二中找到最接近的匹配项。举个例子，假设我有数据框 1：

shift_1 <- c(1,1,0,2)
length_1 <- c(100,120,5,70)
level_1<- c(1,3,5,4)
age_1 <- c(4.5,3.2,3,2.5)

df_1 <- data.frame(shift_1,level_1,age_1,length_1)

  shift_1 level_1 age_1 length_1
1       1       1   4.5      100
2       1       3   3.2      120
3       0       5   3.0        5
4       2       4   2.5       70

对于这个数据框的每一行，我想在数据框2中找到最接近的匹配，如下所示：

shift_2 <- c(1,1,2,1,0)
length_2 <- c(100,200,40,180,10)
level_2<- c(3,4,4,3,5)
age_2 <- c(2.5,5.5,2.2,3.1,5)

df_2 <- data.frame(shift_2,level_2,age_2,length_2)

  shift_2 level_2 age_2 length_2
1       1       3   2.5      100
2       1       4   5.5      200
3       2       4   2.2       40
4       1       3   3.1      180
5       0       5   5.0       10

基于这些标准： shift must 完全匹配。级别必须完全匹配。年龄将被接受20%差异。

如果我们找到匹配项：我们要添加匹配行的索引号和匹配信息，否则我们将添加NA。所以预期的结果是这样的形式：

  shift_r level_r age_r length_r index shift_match level_match age_match length_match
1       1       1   4.5      100    NA          NA          NA        NA           NA
2       1       3   3.2      120     4           1           3       3.1          180
3       0       5   3.0        5    NA          NA          NA        NA           NA
4       2       4   2.5       70     3           2           4       2.2           40

您能告诉我应该如何处理这个问题吗？有没有任何库可以使这项任务变得更容易？

r dataframe dplyr pattern-matching
1个回答
2
投票

您需要“非等值”或“范围”连接。这是在 R 的 

fuzzyjoin
和 
data.table
包中实现的。由于 SQL 也支持它，因此也可以使用 
sqldf
。

遗憾的是，

dplyr
本身不支持此功能。由于 SQL 支持此操作，因此如果您的数据位于数据库中，那么 
dbplyr
将允许它使用其 
sql_on
，但不是本机的。

编辑：添加 

dplyr
以及最近添加的 
join_by
。

首先，我们需要添加 20% 的容差：

df_1$age_1_start <- df_1$age_1 * 0.8
df_1$age_1_end <- df_1$age_1 * 1.2
df_1
#   shift_1 level_1 age_1 length_1 age_1_start age_1_end
# 1       1       1   4.5      100        3.60      5.40
# 2       1       3   3.2      120        2.56      3.84
# 3       0       5   3.0        5        2.40      3.60
# 4       2       4   2.5       70        2.00      3.00

模糊连接

fuzzyjoin::fuzzy_left_join(
  df_1, df_2,
  by = c("shift_1" = "shift_2", "level_1" = "level_2",
         "age_1_start" = "age_2", "age_1_end" = "age_2"),
  match_fun = list(`==`, `==`, `<=`, `>=`))
#   shift_1 level_1 age_1 length_1 age_1_start age_1_end shift_2 level_2 age_2 length_2
# 1       1       1   4.5      100        3.60      5.40      NA      NA    NA       NA
# 2       1       3   3.2      120        2.56      3.84       1       3   3.1      180
# 3       0       5   3.0        5        2.40      3.60      NA      NA    NA       NA
# 4       2       4   2.5       70        2.00      3.00       2       4   2.2       40

数据表

library(data.table)
DT_1 <- as.data.table(df_1) # must include age_1_start and age_1_end from above
DT_2 <- as.data.table(df_2)

DT_2[DT_1, on = .(shift_2 == shift_1, level_2 == level_1, age_2 >= age_1_start, age_2 <= age_1_end)]
#    shift_2 level_2 age_2 length_2 age_2.1 age_1 length_1
# 1:       1       1  3.60       NA    5.40   4.5      100
# 2:       1       3  2.56      180    3.84   3.2      120
# 3:       0       5  2.40       NA    3.60   3.0        5
# 4:       2       4  2.00       40    3.00   2.5       70

此包倾向于根据右侧的名称重命名左侧 (

DT_1
) 连接，这可能会令人沮丧。为此，您需要事后进行一些清理。

sqldf

sqldf::sqldf(
  "select t1.*, t2.*
   from df_1 t1
     left join df_2 t2 on t1.shift_1 = t2.shift_2 and t1.level_1 = t2.level_2
       and t1.age_1_start <= t2.age_2 and t1.age_1_end >= t2.age_2")
#   shift_1 level_1 age_1 length_1 age_1_start age_1_end shift_2 level_2 age_2 length_2
# 1       1       1   4.5      100        3.60      5.40      NA      NA    NA       NA
# 2       1       3   3.2      120        2.56      3.84       1       3   3.1      180
# 3       0       5   3.0        5        2.40      3.60      NA      NA    NA       NA
# 4       2       4   2.5       70        2.00      3.00       2       4   2.2       40

dplyr

library(dplyr)
df_1 %>%
  mutate(
    age_1_start = age_1 * 0.8,
    age_1_end = age_1 * 1.2
  ) %>%
  left_join(df_2, join_by(shift_1 == shift_2, level_1 == level_2, 
                          age_1_start <= age_2, age_1_end >= age_2))
#   shift_1 level_1 age_1 length_1 age_1_start age_1_end age_2 length_2
# 1       1       1   4.5      100        3.60      5.40    NA       NA
# 2       1       3   3.2      120        2.56      3.84   3.1      180
# 3       0       5   3.0        5        2.40      3.60    NA       NA
# 4       2       4   2.5       70        2.00      3.00   2.2       40

如果您了解 SQL，那么最后一个可能是最直观、最容易吸收的。但请记住，对于较大的框架，它将整个框架复制到内存存储 SQLite 实例中......这不是“免费的”。

fuzzyjoin
的实现给了你很大的力量，而且它的论点（对我来说）似乎很容易理解。结果按照我的预期命名。然而，它是三个实现中最慢的（使用此数据）。 （只有当您的真实数据“非常”大时，这才应该是一个问题。）

如果您还不知道

data.table
，尽管它的速度极快，但它的 R 方言对于不知情的人来说可能有点晦涩难懂。我相信它具有与 
fuzzyjoin
一样强大的功能，尽管我还没有测试所有极端情况以查看其中一个是否支持另一个不支持的内容。

bench::mark(
  fuzzyjoin = fuzzyjoin::fuzzy_left_join(
    df_1, df_2,
    by = c("shift_1" = "shift_2", "level_1" = "level_2",
           "age_1_start" = "age_2", "age_1_end" = "age_2"),
    match_fun = list(`==`, `==`, `<=`, `>=`)),
  data.table = DT_2[DT_1, on = .(shift_2 == shift_1, level_2 == level_1, age_2 >= age_1_start, age_2 <= age_1_end)],
  sqldf = sqldf::sqldf(
    "select t1.*, t2.*
     from df_1 t1
       left join df_2 t2 on t1.shift_1 = t2.shift_2 and t1.level_1 = t2.level_2
         and t1.age_1_start <= t2.age_2 and t1.age_1_end >= t2.age_2"),
  check = FALSE
)
# # A tibble: 3 x 13
#   expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory        time      gc       
#   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>        <list>    <list>   
# 1 fuzzyjoin  134.12ms 143.24ms      6.98     107KB     6.98     2     2      286ms <NULL> <Rprofmem[,3~ <bch:tm ~ <tibble ~
# 2 data.table   2.14ms   2.63ms    335.       114KB     2.06   163     1      487ms <NULL> <Rprofmem[,3~ <bch:tm ~ <tibble ~
# 3 sqldf       21.14ms  22.72ms     42.9      184KB     4.52    19     2      442ms <NULL> <Rprofmem[,3~ <bch:tm ~ <tibble ~
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.