使用(如果可能)函数方法修改基于正则表达式 (regex) 向量的向量
Modify a vector based on a vector of regular expressions (regex) using (if possible) a functional approach
我有一个包含一些列的数据框,我想修改这些列,具体取决于它们是否与包含在具有正则表达式的向量中的某些模式匹配
library(fuzzyjoin)
library(tidyverse)
(df <- tribble(~a,
"GUA-ABC",
"REF-CDE",
"ACC.S93",
"ACC.ATN"))
#> # A tibble: 4 x 1
#> a
#> <chr>
#> 1 GUA-ABC
#> 2 REF-CDE
#> 3 ACC.S93
#> 4 ACC.ATN
根据我想粘贴文本的模式,例如,对于包含 GUA 的模式,在由点连接的链的末端粘贴“GUA001”,对于包含 REF 的模式,粘贴“GUA002”同理,可以得到:
# This is the resulting data.frame I need
#> # A tibble: 4 x 1
#> a
#> <chr>
#> 1 GUA-ABC.GUA001
#> 2 REF-CDE.GUA002
#> 3 ACC.S93
#> 4 ACC.ATN
我想到了一些办法
方法 # 1
# list of patterns to search
patterns <- c("\b^GUA\b", "\b^REF\b")
# Create a named list for recoding
model_key <- list("\b^GUA\b" = "GUA001",
"\b^REF\b" = "GUA002")
# Create a data.frame of regexs
(k <- tibble(regex = patterns))
#> # A tibble: 2 x 1
#> regex
#> <chr>
#> 1 "\b^GUA\b"
#> 2 "\b^REF\b"
# perform a regex_left_join to identify the pattern
df %>%
regex_left_join(k, by = c(a = "regex")) %>%
mutate(
across(regex, recode, !!!model_key),
a = case_when(
!is.na(regex) ~ str_c(a, regex, sep = "."),
TRUE ~ a)
) %>% select(-regex)
#> # A tibble: 4 x 1
#> a
#> <chr>
#> 1 GUA-ABC.GUA001
#> 2 REF-CDE.GUA002
#> 3 ACC.S93
#> 4 ACC.ATN
为什么这种方法不是最优的?原始数据框有数百万行,fuzzyjoin::regex_left_join
需要很长时间才能完成。
方法 # 2
patron <- c("GUA001" = "\b^GUA\b", "GUA002" = "\b^REF\b")
newtex <- c("GUA001", "GUA002")
pegar <- function(string, pattern, text_to_paste) {
if_else(condition = str_detect(string, pattern),
true = str_c(string, text_to_paste, sep = "."),
false = string)
}
map2_dfr(.x = patron, .y = newtex, ~ pegar(string = df$a,
pattern = .x,
text_to_paste = .y))
#> # A tibble: 4 x 2
#> GUA001 GUA002
#> <chr> <chr>
#> 1 GUA-ABC.GUA001 GUA-ABC
#> 2 REF-CDE REF-CDE.GUA002
#> 3 ACC.S93 ACC.S93
#> 4 ACC.ATN ACC.ATN
由 reprex package (v2.0.0)
于 2021-05-20 创建
使用方法 # 2 我无法获得单个列。
附带说明一下,使用 str_replace_all
并使用命名向量替换字符串中的某些值目前似乎不是一个好的选择。
有没有办法更优化地做到这一点?
利用 stringr
和 purrr
的一个选项可能是:
imap_dfr(model_key,
~ df %>%
filter(str_detect(a, .y)) %>%
mutate(a = str_c(a, .x, sep = "."))) %>%
bind_rows(df %>%
filter(str_detect(a, str_c(names(model_key), collapse = "|"), negate = TRUE)))
a
<chr>
1 GUA-ABC.GUA001
2 REF-CDE.GUA002
3 ACC.S93
4 ACC.ATN
无聊的旧循环怎么样?
## make df millions of rows
df <- df[rep(1:4,1e6),]
system.time({
val <- c("GUA\-", "REF\-", "ACC\.", "QQQ\.")
rpl <- c("GUA001", "GUA002", "ACC001", "QQQ001")
for(i in seq_along(val)) {
sel <- grepl(val[i], df$a)
df$a[sel] <- paste(df$a[sel], rpl[i], sep=".")
}
})
## user system elapsed
## 2.14 0.03 2.17
2 秒完成
df
## A tibble: 4,000,000 x 1
# a
# <chr>
# 1 GUA-ABC.GUA001
# 2 REF-CDE.GUA002
# 3 ACC.S93.ACC001
# 4 ACC.ATN.ACC001
# ...
如果函数方法是绝对必要的,你可以把它压缩成一个Reduce
函数:
Reduce(
function(str, args) {
sel <- grepl(args[1], str)
str[sel] <- paste(str[sel], args[2], sep=".")
str
},
Map(c, val, rpl), init = df$a
)
我有一个包含一些列的数据框,我想修改这些列,具体取决于它们是否与包含在具有正则表达式的向量中的某些模式匹配
library(fuzzyjoin)
library(tidyverse)
(df <- tribble(~a,
"GUA-ABC",
"REF-CDE",
"ACC.S93",
"ACC.ATN"))
#> # A tibble: 4 x 1
#> a
#> <chr>
#> 1 GUA-ABC
#> 2 REF-CDE
#> 3 ACC.S93
#> 4 ACC.ATN
根据我想粘贴文本的模式,例如,对于包含 GUA 的模式,在由点连接的链的末端粘贴“GUA001”,对于包含 REF 的模式,粘贴“GUA002”同理,可以得到:
# This is the resulting data.frame I need
#> # A tibble: 4 x 1
#> a
#> <chr>
#> 1 GUA-ABC.GUA001
#> 2 REF-CDE.GUA002
#> 3 ACC.S93
#> 4 ACC.ATN
我想到了一些办法
方法 # 1
# list of patterns to search
patterns <- c("\b^GUA\b", "\b^REF\b")
# Create a named list for recoding
model_key <- list("\b^GUA\b" = "GUA001",
"\b^REF\b" = "GUA002")
# Create a data.frame of regexs
(k <- tibble(regex = patterns))
#> # A tibble: 2 x 1
#> regex
#> <chr>
#> 1 "\b^GUA\b"
#> 2 "\b^REF\b"
# perform a regex_left_join to identify the pattern
df %>%
regex_left_join(k, by = c(a = "regex")) %>%
mutate(
across(regex, recode, !!!model_key),
a = case_when(
!is.na(regex) ~ str_c(a, regex, sep = "."),
TRUE ~ a)
) %>% select(-regex)
#> # A tibble: 4 x 1
#> a
#> <chr>
#> 1 GUA-ABC.GUA001
#> 2 REF-CDE.GUA002
#> 3 ACC.S93
#> 4 ACC.ATN
为什么这种方法不是最优的?原始数据框有数百万行,fuzzyjoin::regex_left_join
需要很长时间才能完成。
方法 # 2
patron <- c("GUA001" = "\b^GUA\b", "GUA002" = "\b^REF\b")
newtex <- c("GUA001", "GUA002")
pegar <- function(string, pattern, text_to_paste) {
if_else(condition = str_detect(string, pattern),
true = str_c(string, text_to_paste, sep = "."),
false = string)
}
map2_dfr(.x = patron, .y = newtex, ~ pegar(string = df$a,
pattern = .x,
text_to_paste = .y))
#> # A tibble: 4 x 2
#> GUA001 GUA002
#> <chr> <chr>
#> 1 GUA-ABC.GUA001 GUA-ABC
#> 2 REF-CDE REF-CDE.GUA002
#> 3 ACC.S93 ACC.S93
#> 4 ACC.ATN ACC.ATN
由 reprex package (v2.0.0)
于 2021-05-20 创建使用方法 # 2 我无法获得单个列。
附带说明一下,使用 str_replace_all
并使用命名向量替换字符串中的某些值目前似乎不是一个好的选择。
有没有办法更优化地做到这一点?
利用 stringr
和 purrr
的一个选项可能是:
imap_dfr(model_key,
~ df %>%
filter(str_detect(a, .y)) %>%
mutate(a = str_c(a, .x, sep = "."))) %>%
bind_rows(df %>%
filter(str_detect(a, str_c(names(model_key), collapse = "|"), negate = TRUE)))
a
<chr>
1 GUA-ABC.GUA001
2 REF-CDE.GUA002
3 ACC.S93
4 ACC.ATN
无聊的旧循环怎么样?
## make df millions of rows
df <- df[rep(1:4,1e6),]
system.time({
val <- c("GUA\-", "REF\-", "ACC\.", "QQQ\.")
rpl <- c("GUA001", "GUA002", "ACC001", "QQQ001")
for(i in seq_along(val)) {
sel <- grepl(val[i], df$a)
df$a[sel] <- paste(df$a[sel], rpl[i], sep=".")
}
})
## user system elapsed
## 2.14 0.03 2.17
2 秒完成
df
## A tibble: 4,000,000 x 1
# a
# <chr>
# 1 GUA-ABC.GUA001
# 2 REF-CDE.GUA002
# 3 ACC.S93.ACC001
# 4 ACC.ATN.ACC001
# ...
如果函数方法是绝对必要的,你可以把它压缩成一个Reduce
函数:
Reduce(
function(str, args) {
sel <- grepl(args[1], str)
str[sel] <- paste(str[sel], args[2], sep=".")
str
},
Map(c, val, rpl), init = df$a
)