Частичное сопоставление строк в R и обрезка символов

Вот кадр данных и вектор.

df1  <-  tibble(var1 = c("abcd", "efgh", "ijkl", "mnopqr", "qrst"))
vec <-  c("ab", "mnop", "ijk")

Теперь для всех значений в var1, которые ближе всего соответствуют (я хотел бы сопоставить первые n символов) со значениями в vec, оставьте только до первых 3 символов vec в var1, чтобы желаемое решение является:

df2 <- tibble(var1 = c("ab", "efgh", "ijk", "mno", "qrst"))

Поскольку «abcd» ближе всего соответствует «ab» в vec, мы сохраняем только до 3 символов «ab», т.е. 2 в данном случае, в df2, но «efgh» не существует в vec, поэтому мы оставляем его как есть. то есть "efgh" в df2 и так далее.

Могу ли я использовать для этого dplyr, stringr, fuzzyjoin, agrep или fuzzywuzzyr? Вы можете использовать следующее, предложенное здесь https://stackoverflow.com/a/51053674/6762788, благодаря Псидом.

df1 %>% 
    mutate(var1 = ifelse(var1 %in% vec, substr(var1, 1, 3), var1))

person Geet    schedule 28.06.2018    source источник
comment
что, если значение «tmnop» было в var1, вернуло бы оно «mno» или ничего? Что, если 'nope' находится в var1, будет ли он возвращать nop или ничего?   -  person Mark    schedule 28.06.2018
comment
Я хотел бы сопоставить первые n символов. Таким образом, tmnop и nope должны возвращать tmnop и nope точно так же, как efgh.   -  person Geet    schedule 28.06.2018


Ответы (2)


Вот двухэтапное решение. Во-первых, функция, выполняющая нечеткое сопоставление и замену первых n символов. Он запускает agrepl для сопоставления входного шаблона с предоставленным вектором и сохраняет до первых n символов, если они совпадают. Если совпадений нет, возвращается NA. Это предназначено для применения к вектору шаблонов через lapply, поэтому вторая функция предназначена для Reduce, чтобы превратить его в один вектор. reducer принимает два вектора одинаковой длины и заменяет все экземпляры первого, где второй не равен NA, неотсутствующим значением второго.

Все это завершается парой вызовов и возвращает желаемый вектор.

fuzzy_match_and_replace = function(pattern, vector, n = 3){
  n = min(c(n,nchar(pattern)))
  match = agrepl(pattern,vector)
  pattern_first_n = substr(pattern,1,n)
  vector_first_n = substr(vector,1,n)
  output = rep(NA,length(vector))
  output[match & pattern_first_n == vector_first_n] = pattern_first_n
  return(output)
}

reducer = function(a,b){
  a[!is.na(b)] = b[!is.na(b)]
  return(a)
}


df1  <-  data.frame(var1 = c("abcd", "efgh", "ijkl", "mnopqr", "qrst"), stringsAsFactors = FALSE)
vec <-  c("ab", "mnop", "ijk")
Reduce(reducer,lapply(vec,fuzzy_match_and_replace,vector=df1$var1),init=df1$var1)
#> [1] "ab"   "efgh" "ijk"  "mno"  "qrst"

Если вы хотите, чтобы он работал на этапе мутации, у вас может быть оболочка, подобная следующей

wrapper = function(pattern, vector, n = 3){
  Reduce(reducer,lapply(pattern,fuzzy_match_and_replace,vector=vector,n=n),init=vector)
}

ОБНОВИТЬ

Вот более простая функция (1 шаг), которая использует adist из ответа Онямбу, но не полагаясь на max.col, вместо этого, используя vapply, она проходит через матрицу, идентифицируя совпадение и выполняя замену.

fuzzy_match_and_replace = function(pattern, vector, n = 3, ...){
  matches = adist(pattern,vector,partial=T,...) == 0
  replace = vapply(apply(matches,2,which)
                  ,function(x){
                    if(length(x) > 0) return(substr(pattern,1,n)[x]) else return(NA_character_)
                   }
                  ,FUN.VALUE = c(""))
  vector[!is.na(replace)] = replace[!is.na(replace)]
  return(vector)
}

library(dplyr)
df1  <-  tibble(var1 = c("abcd", "efgh", "ijkl", "mnopqr", "qrst","mnopr"))
vec <-  c("ab", "mnop", "ijk")

df1%>%
  mutate(var1=fuzzy_match_and_replace(vec,var1))
#> # A tibble: 6 x 1
#>   var1 
#>   <chr>
#> 1 ab   
#> 2 efgh 
#> 3 ijk  
#> 4 mno  
#> 5 qrst 
#> 6 mno
person Mark    schedule 28.06.2018
comment
Спасибо за подробное объяснение и создание таких сложных функций для решения этой проблемы! - person Geet; 28.06.2018
comment
Большой! Можете ли вы также сделать его нечувствительным к регистру? - person Geet; 28.06.2018
comment
Во второй функции вы можете передавать аргументы в adist через ..., поэтому просто добавьте ignore.case=TRUE - person Mark; 29.06.2018
comment
Это делает его намного более гибким. - person Mark; 29.06.2018
comment
Я не смогу воспроизвести свои реальные данные, но описанный выше метод дал мне эту ошибку: Столбец var1 должен иметь длину 2 (размер группы) или один, а не 4. Любая идея, в чем может быть проблема и как это исправить ? - person Geet; 29.06.2018

person    schedule
comment
Это действительно интересно! Можете ли вы также сделать его нечувствительным к регистру и другой переменной, скажем, var2? Итак, AB должно совпадать с ab и так далее. - person Geet; 28.06.2018
comment
@Get внутри функции adist(...,ignore.case=TRUE) включите ignore.case=TRUE или даже в функцию grep вы можете включить ignore.case=TRUE это сделает ее нечувствительной к регистру - person Onyambu; 28.06.2018
comment
Это решение работает для данного примера, но не работает, когда в df1 больше совпадений, например. df1 <- tibble(var1 = c("abcd", "efgh", "ijkl", "mnopqr", "qrst","mnopr")) - в этом случае вывод оставляет mnopqr без изменений - person Mark; 28.06.2018
comment
@Onyambu: я не смогу воспроизвести свои реальные данные, но описанный выше метод дал мне эту ошибку: столбец var1 должен иметь длину 2 (размер группы) или один, а не 1166955. Любая идея, в чем может быть проблема и как исправить это? - person Geet; 29.06.2018
comment
@Get Ваши данные сгруппированы. Вам нужно разгруппировать его. т.е. df1%>%ungroup()%>%mutate(...) - person Onyambu; 29.06.2018