R中的部分字符串匹配并修剪字符

这是一个数据帧和一个向量

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

---

这里有一个两步解决方案。首先是一个函数，它对前n个字符进行模糊匹配和替换。它运行

agrepl

，将输入模式与提供的向量相匹配，并保持第一个

n

字符（如果匹配）。如果没有匹配项，则返回

NA

。这是为了通过

lappy

应用于模式向量，因此第二个函数用于

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"

更新 这里有一个更简单的函数（1步），它利用了Onyanbu答案中的

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

模糊匹配和替换=函数（模式，向量，n=3，…）{
匹配=adist（模式，向量，部分=T，…）=0
替换=vapply（应用（匹配，2，其中）
，函数（x）{
if（length（x）>0）返回（substr（pattern，1，n）[x]），否则返回（NA_字符）
}
，FUN.VALUE=c（“”）
向量[！is.na（替换）]=替换[！is.na（替换）]
返回（向量）
}
图书馆（dplyr）
df1#A tible:6 x 1
#>var1
#>   
#>1 ab
#>2 efgh
#>3 ijk
#>4 mno
#>5QRST
#>6 mno

df1%
突变（var1=replace（var1，a[，2]，substr（vec[a[，1]]，1,3）））
#一个tibble:6x1
var1
1 ab
2 efgh
3 ijk
4 mno
5QRST
6 mno

如果值“tmnop”在var1中，它会返回“mno”还是什么都不返回呢？如果“nope”在var1中，它会返回

nop

还是什么都不返回呢？我想匹配前n个字符。所以tmnop和nope应该像efgh一样返回tmnop和nope。感谢您的详细解释和创建如此复杂的函数来解决这个问题！伟大的您还可以使其不区分大小写吗？在第二个函数中，您可以通过

..

将参数传递给

adist

，因此只需添加ignore.case=TRUEIt就可以使其更加灵活。我无法再现真实数据，但上面的方法给了我以下错误：列var1的长度必须为2（组大小）或1，而不是4。知道问题出在哪里吗？知道怎么解决吗？真有趣！您是否也可以将其设置为不区分大小写和另一个变量，例如var2？因此，AB应该与AB匹配，依此类推。@Geet在函数中

adist（…，ignore.case=TRUE）

包括

ignore.case=TRUE

甚至在

grep

函数中，您可以包括

ignore.case=TRUE

这将使其不区分大小写此解决方案适用于给定示例，但在df1中有更多匹配项时会出现故障，例如

df1@Onyambu:我将无法再现真实数据，但上述方法给了我以下错误：列var1必须是长度2（组大小）或1，不是1166955。知道问题出在哪里以及如何解决吗？@Geet您的数据已分组。你需要把它解组。ie
df1%%>%ungroup（）%%>%mutate（…）
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)
}

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

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