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

Question

Вот датафрейм и вектор.

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 ​​для этого? Вы можете использовать следующие предложенные здесь /questions/8749751/sopostavit-vektor-simvolov-v-kadre-dannyih-s-drugim-vektorom-simvolov-i-simvolom-usecheniya/8749763#8749763, благодаря Psidom.

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

Answer 1

df1 <- tibble(var1 = c("abcd", "efgh", "ijkl", "mnopqr", "qrst","mnopr"))

a = which(adist(vec,df1$var1,partial = T,ignore.case = T)==0,T)

df1%>%
  mutate(var1=replace(var1,a[,2],substr(vec[a[,1]],1,3)))
# A tibble: 6 x 1
  var1 
  <chr>
1 ab   
2 efgh 
3 ijk  
4 mno  
5 qrst 
6 mno  

Answer 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 из ответа Onyambu, но не полагаясь на 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