R中的部分字符串匹配和trim字符
Partial string matching in R and trim the characters
这是一个数据框和一个向量。
df1 <- tibble(var1 = c("abcd", "efgh", "ijkl", "mnopqr", "qrst"))
vec <- c("ab", "mnop", "ijk")
现在,对于 var1 中与 vec 中的值最匹配(我想匹配前 n 个字符)的所有值,只保留 upto 的前 3 个字符vec in var1 这样所需的解决方案是:
df2 <- tibble(var1 = c("ab", "efgh", "ijk", "mno", "qrst"))
因为 "abcd" 与 vec 中的 "ab" 最匹配,我们只保留最多 3 个 "ab" 字符,即在本例中为 2 个字符,在 df2 中,但 "efgh" vec 中不存在,所以我们保持原样,即 df2 中的 "efgh" 等等。
我可以使用 dplyr、stringr、fuzzyjoin、agrep 或 fuzzywuzzyr 来实现吗?感谢 Psidom,您可能希望根据此处建议的以下内容构建 。
df1 %>%
mutate(var1 = ifelse(var1 %in% vec, substr(var1, 1, 3), var1))
这是一个两步解决方案。首先,一个用前 n 个字符进行模糊匹配和替换的函数。它运行 agrepl
以将输入模式与提供的向量相匹配,并在匹配时保留前 n
个字符。如果没有匹配,则为 returns NA
。这旨在通过 lapply
应用于模式向量,因此第二个函数用于 Reduce
将其转换为一个向量。 reducer
接收两个相同长度的向量,并用第二个的非缺失值替换第一个向量中第二个不是 NA
的所有实例。
这一切都包含在几个调用中,returns 所需的矢量。
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"
如果你想让它在 mutate 步骤中工作,你可以有一个像下面这样的包装器
wrapper = function(pattern, vector, n = 3){
Reduce(reducer,lapply(pattern,fuzzy_match_and_replace,vector=vector,n=n),init=vector)
}
更新
这是一个更简单的函数(1 步),它利用 Onyambu 的回答中的 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
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
这是一个数据框和一个向量。
df1 <- tibble(var1 = c("abcd", "efgh", "ijkl", "mnopqr", "qrst"))
vec <- c("ab", "mnop", "ijk")
现在,对于 var1 中与 vec 中的值最匹配(我想匹配前 n 个字符)的所有值,只保留 upto 的前 3 个字符vec in var1 这样所需的解决方案是:
df2 <- tibble(var1 = c("ab", "efgh", "ijk", "mno", "qrst"))
因为 "abcd" 与 vec 中的 "ab" 最匹配,我们只保留最多 3 个 "ab" 字符,即在本例中为 2 个字符,在 df2 中,但 "efgh" vec 中不存在,所以我们保持原样,即 df2 中的 "efgh" 等等。
我可以使用 dplyr、stringr、fuzzyjoin、agrep 或 fuzzywuzzyr 来实现吗?感谢 Psidom,您可能希望根据此处建议的以下内容构建
df1 %>%
mutate(var1 = ifelse(var1 %in% vec, substr(var1, 1, 3), var1))
这是一个两步解决方案。首先,一个用前 n 个字符进行模糊匹配和替换的函数。它运行 agrepl
以将输入模式与提供的向量相匹配,并在匹配时保留前 n
个字符。如果没有匹配,则为 returns NA
。这旨在通过 lapply
应用于模式向量,因此第二个函数用于 Reduce
将其转换为一个向量。 reducer
接收两个相同长度的向量,并用第二个的非缺失值替换第一个向量中第二个不是 NA
的所有实例。
这一切都包含在几个调用中,returns 所需的矢量。
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"
如果你想让它在 mutate 步骤中工作,你可以有一个像下面这样的包装器
wrapper = function(pattern, vector, n = 3){
Reduce(reducer,lapply(pattern,fuzzy_match_and_replace,vector=vector,n=n),init=vector)
}
更新
这是一个更简单的函数(1 步),它利用 Onyambu 的回答中的 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
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