从R中的字符串向量匹配单词答案

【问题标题】：Matching words from vectors of strings in R从R中的字符串向量匹配单词
【发布时间】：2020-12-03 10:35:50
【问题描述】：

我正在尝试通过将混乱的网站名称列表与已批准的列表进行匹配来清理数据库。

例如，首选站点名称可能是“Cotswold Water Park Pit 28”，但该站点已输入数据库中：“Pit 28”、“28”、“CWP Pit 28”和“Cotswold 28” '。

数据看起来像这样：

approved <- c("Cotswold Water Park Pit 28", "Cotswold Water Park Pit 14", "Robinswood Hill")

messy <- c("Pit 28", "28", "CWP Pit 28", "Cotswold 28", "14", "Robinswood")

我正在寻找一种方法来匹配messy 中每个元素中的单词/数字（非空格字符的簇）与approved 中每个元素中的单词/数字。理想情况下，我会得到这样的结果：

     Cotswold Water Park Pit 28 Cotswold Water Park Pit 14 Robinswood Hill
[1,] "Pit 28"                   "Pit 28"                   "Robinswood"   
[2,] "28"                       "CWP Pit 28"               NA             
[3,] "CWP Pit 28"               "14"                       NA             
[4,] "Cotswold 28"              NA                         NA

approved 元素构成列名，messy 中包含匹配单词/数字的任何元素都出现在该列的单元格中。我知道会有一些错误的匹配。这很好，我可以稍后手动过滤它们，并且可能会从模式匹配中排除“森林”和“山丘”等常用词。

通过使用regex 拆分messy 中的每个元素，我已经能够使用上述示例数据获得我想要的结果，但是我正在处理来自站点名称列表的单词/数字列表和我不得不使用嵌套循环或sapply 将它们与已批准的元素匹配，因为像grep、grepl 和str_detect 这样的函数只允许一种模式。由于数据库很大，当我将它应用于整个事情时，这需要很长时间。我真正想要的是一个功能：

match(any word in approved[1], any word in messy[1])

如果匹配，给我一个TRUE FALSE 输出或提取messy[1] 会很棒！

【问题讨论】：

为什么"Cotswold 28" 与"Cotswold Water Park Pit 14" 不匹配？ "Cotswold" 是它们之间的共同点。

标签： r regex string string-matching stringr

【解决方案1】：

tidyverse/tidytext 解决方案

先把它们变成数据框

require(tidyverse) 
require(tidytext)


## create dataframe for approved 

approved <- c("Cotswold Water Park Pit 28", "Cotswold Water Park Pit 14", "Robinswood Hill")


## create dataframe for messy 

messy <- c("Pit 28", "28", "CWP Pit 28", "Cotswold 28", "14", "Robinswood")

然后使用 tidytext 将它们拆分为 1 个单词 = 1 行，我喜欢在行数发生变化时添加 ID ...

## split into words 

approved_df <- 
tibble(approved = approved) %>%  
  rownames_to_column('approved_id') %>% 
  unnest_tokens(words, approved, 'words', drop = FALSE)

approved_df %>%  head 

# A tibble: 6 x 3
# approved_id approved                   words   
# <chr>       <chr>                      <chr>   
# 1 1           Cotswold Water Park Pit 28 cotswold
# 2 1           Cotswold Water Park Pit 28 water   
# 3 1           Cotswold Water Park Pit 28 park    
# 4 1           Cotswold Water Park Pit 28 pit     
# 5 1           Cotswold Water Park Pit 28 28      
# 6 2           Cotswold Water Park Pit 14 cotswold
    
messy_df <- 
tibble(messy = messy) %>%  
  rownames_to_column('messy_id') %>% 
  unnest_tokens(words, messy, 'words', drop = FALSE)

messy_df %>%  head          
# # A tibble: 6 x 3
# messy_id messy      words
# <chr>    <chr>      <chr>
# 1 1        Pit 28     pit  
# 2 1        Pit 28     28   
# 3 2        28         28   
# 4 3        CWP Pit 28 cwp  
# 5 3        CWP Pit 28 pit  
# 6 3        CWP Pit 28 28

最后，在单词级别加入两个数据框，计算重叠的单词数量，然后为每个“混乱”字符串分配一个“已批准”

     ## join the data sets and rank by the number of words in the overlap
  
  messy_df %>%  left_join(approved_df) %>%  
    group_by(messy, messy_id, approved, approved_id) %>%  
    summarise(n_row = n()) %>%  
    ungroup %>%  
    group_by(messy, messy_id) %>%  
    mutate(approved_rank = rank(desc(n_row))) %>%  
    ungroup %>%  
    filter(approved_rank == 1) %>%  
    arrange(messy_id)



  # Joining, by = "words"
  # # A tibble: 6 x 6
  # messy       messy_id approved                   approved_id n_row approved_rank
  # <chr>       <chr>    <chr>                      <chr>       <int>         <dbl>
  # 1 Pit 28      1        Cotswold Water Park Pit 28 1               2             1
  # 2 28          2        Cotswold Water Park Pit 28 1               1             1
  # 3 CWP Pit 28  3        Cotswold Water Park Pit 28 1               2             1
  # 4 Cotswold 28 4        Cotswold Water Park Pit 28 1               2             1
  # 5 14          5        Cotswold Water Park Pit 14 2               1             1
  # 6 Robinswood  6        Robinswood Hill            3               1             1

【讨论】：

感谢 Mouad_Seridi！使用您的示例时出现两个错误：1）当我运行'approved_df %>% head'时，我得到'check_dots_used（action = warn）中的错误：未使用的参数（action = warn）'
2) 当我尝试加入并对数据集进行排名时，我得到“错误：n() 只能在数据上下文中调用运行rlang::last_error() 以查看错误发生的位置。”当我运行 'rlang::last_error(): <error/rlang_error> n() should only be called in a data context Backtrace: 1. dplyr::left_join(., approved_df) 1. dplyr::group_by(., messy, messy_id, approved, approved_id) 8. plyr::summarise(., n_row = n()) 9. [ base::eval(...) ] with 1 more call 11. dplyr::n() 12. dplyr:::from_context("..group_size") 13. %||%(...) Run rlang::last_trace()` 来查看完整的上下文时。
这段代码的运行与为我编写的完全一样。提问者是否试图将其应用于不同的问题？
根据我的经验，这种分析文本的整洁方法也是最快的。它会比模糊匹配或字符串距离快得多。

【解决方案2】：

我不确定我下面的尝试是否符合您的目的

res <- within(
  expand.grid(messy, approved),
  matched <- do.call(
    function(...) lengths(mapply(intersect, ...)) > 0,
    unname(expand.grid(strsplit(messy, " "), strsplit(approved, " ")))
  )
)

给予

          Var1                       Var2 matched
1       Pit 28 Cotswold Water Park Pit 28    TRUE
2           28 Cotswold Water Park Pit 28    TRUE
3   CWP Pit 28 Cotswold Water Park Pit 28    TRUE
4  Cotswold 28 Cotswold Water Park Pit 28    TRUE
5           14 Cotswold Water Park Pit 28   FALSE
6   Robinswood Cotswold Water Park Pit 28   FALSE
7       Pit 28 Cotswold Water Park Pit 14    TRUE
8           28 Cotswold Water Park Pit 14   FALSE
9   CWP Pit 28 Cotswold Water Park Pit 14    TRUE
10 Cotswold 28 Cotswold Water Park Pit 14    TRUE
11          14 Cotswold Water Park Pit 14    TRUE
12  Robinswood Cotswold Water Park Pit 14   FALSE
13      Pit 28            Robinswood Hill   FALSE
14          28            Robinswood Hill   FALSE
15  CWP Pit 28            Robinswood Hill   FALSE
16 Cotswold 28            Robinswood Hill   FALSE
17          14            Robinswood Hill   FALSE
18  Robinswood            Robinswood Hill    TRUE

如果您想获得帖子中显示的输出，可以在res 上进一步玩一些技巧，例如，

res2 <- do.call(
  cbind,
  lapply(
    u <- with(subset(res, matched), split(Var1, Var2)),
    function(x) `length<-`(as.vector(x), max(lengths(u)))
  )
)

这样

> res2
     Cotswold Water Park Pit 28 Cotswold Water Park Pit 14 Robinswood Hill
[1,] "Pit 28"                   "Pit 28"                   "Robinswood"
[2,] "28"                       "CWP Pit 28"               NA
[3,] "CWP Pit 28"               "Cotswold 28"              NA
[4,] "Cotswold 28"              "14"                       NA

【讨论】：

【解决方案3】：

也许你正在寻找adist：

x <- adist(messy, approved, fixed=FALSE, ignore.case = TRUE)
y <- t(adist(approved, messy, fixed=FALSE, ignore.case = TRUE))
i <- x == apply(x, 1, min)
y[!i]  <- NA
colnames(y) <- approved
i <- apply(y == apply(y, 1, min, na.rm=TRUE), 2, function(i) messy[i & !is.na(i)])
do.call(cbind, lapply(i, function(x) x[seq_len(max(lengths(i)))]))
#     Cotswold Water Park Pit 28 Cotswold Water Park Pit 14 Robinswood Hill
#[1,] "Pit 28"                   "14"                       "Robinswood"   
#[2,] "28"                       NA                         NA             
#[3,] "CWP Pit 28"               NA                         NA             
#[4,] "Cotswold 28"              NA                         NA

【讨论】：

【解决方案4】：

基本的 R 选项是：

result <- sapply(approved, function(x) grep(gsub('\\s+', '|', x), messy, value = TRUE))
result
#$`Cotswold Water Park Pit 28`
#[1] "Pit 28"      "28"          "CWP Pit 28"  "Cotswold 28"

#$`Cotswold Water Park Pit 14`
#[1] "Pit 28"      "CWP Pit 28"  "Cotswold 28" "14"         

#$`Robinswood Hill`
#[1] "Robinswood"

这里的逻辑是，我们在approved 中的每个空格处插入管道（|）符号，如果任何单词匹配，则返回messy 中的单词。

要获得与所示格式相同的输出，我们可以这样做：

sapply(result, `[`, 1:max(lengths(result)))

#     Cotswold Water Park Pit 28 Cotswold Water Park Pit 14 Robinswood Hill
#[1,] "Pit 28"                   "Pit 28"                   "Robinswood"   
#[2,] "28"                       "CWP Pit 28"               NA             
#[3,] "CWP Pit 28"               "Cotswold 28"              NA             
#[4,] "Cotswold 28"              "14"                       NA

【讨论】：

【解决方案5】：

这是一个高度灵活的 regex_join 解决方案

library( fuzzyjoin )
library( data.table )
#make data.frames
messy.df <- data.frame( messy ); approved.df <- data.frame( approved )
#create regexes
messy.df$regex <- gsub( " ", "|", messy.df$messy )
#regex join
ans <- regex_full_join( approved.df, messy.df, by = c("approved" = "regex") )
#cast to wide
dcast( setDT(ans), messy~approved, value.var = "messy")[, -1]

#      Cotswold Water Park Pit 14 Cotswold Water Park Pit 28 Robinswood Hill
#   1:                         14                       <NA>            <NA>
#   2:                       <NA>                         28            <NA>
#   3:                 CWP Pit 28                 CWP Pit 28            <NA>
#   4:                Cotswold 28                Cotswold 28            <NA>
#   5:                     Pit 28                     Pit 28            <NA>
#   6:                       <NA>                       <NA>      Robinswood

【讨论】：

【解决方案6】：

这是使用stringi 的一种可能性（它比stringr 快，并且通常比基本R 正则表达式操作更快。当您有可变长度时，此解决方案返回一个应该比矩阵更有效的列表。

library(stringi)
messy_ors <- stri_replace_all(messy, " ", "|")  
lapply(approved, function(x) messy[stri_detect(x, regex = messy_ors)]) 

$`Cotswold Water Park Pit 28`
[1] "Pit 28"      "28"          "CWP Pit 28"  "Cotswold 28"

$`Cotswold Water Park Pit 14`
[1] "Pit 28"      "CWP Pit 28"  "Cotswold 28" "14"         

$`Robinswood Hill`
[1] "Robinswood"

如果你真的需要一个矩阵，你可以将输出转换为：

n <- max(lengths(out))
sapply(out, function(x) x[1:n])

【讨论】：