Вот двухэтапное решение. Во-первых, функция, выполняющая нечеткое сопоставление и замену первых 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
nop
или ничего? - person Mark   schedule 28.06.2018