我想要一个逻辑向量，指示第二个列表中是否存在匹配项。%in%如果您需要精确匹配，可以使用运算符，但是我对任何匹配都感兴趣，因此我创建了%like%运算符：
table <- rownames(mtcars)
table
#> [1] "Mazda RX4" "Mazda RX4 Wag" "Datsun 710"
#> [4] "Hornet 4 Drive" "Hornet Sportabout" "Valiant"
#> [7] "Duster 360" "Merc 240D" "Merc 230"
#> [10] "Merc 280" "Merc 280C" "Merc 450SE"
#> [13] "Merc 450SL" "Merc 450SLC" "Cadillac Fleetwood"
#> [16] "Lincoln Continental" "Chrysler Imperial" "Fiat 128"
#> [19] "Honda Civic" "Toyota Corolla" "Toyota Corona"
#> [22] "Dodge Challenger" "AMC Javelin" "Camaro Z28"
#> [25] "Pontiac Firebird" "Fiat X1-9" "Porsche 914-2"
#> [28] "Lotus Europa" "Ford Pantera L" "Ferrari Dino"
#> [31] "Maserati Bora" "Volvo 142E"
x <- c('Porsche', 'Porsche 914-2', 'Porsche 911', 'Volvo')
x %in% table
#> [1] FALSE TRUE FALSE FALSE
"%like%" <- function(x, table) sapply(x, function(x)
sum(grepl(pattern = x, x = table))>0, USE.NAMES = FALSE)
x %like% table
#> [1] TRUE TRUE FALSE TRUE
不幸的是，%like%操作员非常慢：
library(microbenchmark)
x1 <- c('Porsche', 'Porsche 914-2', 'Porsche 911', 'Volvo')
x2 <- rep(x1, 10)
x3 <- rep(x1, 100)
table <- rownames(mtcars)
"%like%" <- function(x, table) sapply(x, function(x)
sum(grepl(pattern = x, x = table))>0, USE.NAMES = FALSE)
microbenchmark(x1 %in% table, x1 %like% table, times = 1000)
#> Unit: microseconds
#> expr min lq mean median uq max neval
#> x1 %in% table 1.549 1.8635 2.248905 2.2545 2.5000 7.331 1000
#> x1 %like% table 69.697 71.2110 73.235948 72.6555 74.0835 149.087 1000
microbenchmark(x2 %in% table, x2 %like% table, times = 1000)
#> Unit: microseconds
#> expr min lq mean median uq max
#> x2 %in% table 2.327 2.8795 3.330329 3.3055 3.6515 7.539
#> x2 %like% table 573.005 581.0885 590.760082 584.2270 588.2580 1624.687
#> neval
#> 1000
#> 1000
microbenchmark(x3 %in% table, x3 %like% table, times = 1000)
#> Unit: microseconds
#> expr min lq mean median uq max
#> x3 %in% table 9.195 9.950 11.79078 10.923 12.5675 36.341
#> x3 %like% table 5612.931 5707.168 5973.83801 5737.892 5823.7875 11868.495
#> neval
#> 1000
#> 1000
如何加速%like%操作员？
如果您能够接受的精确匹配，你可以使用fixed = T在grepl加快速度
"%birger%" <- function(x, table) sapply(x, function(x)
sum(grepl(pattern = x, x = table))>0, USE.NAMES = FALSE)
'%birger.fixed%' <- function(x, table) sapply(x, function(x)
any(grepl(pattern = x, x = table, fixed = T)), USE.NAMES = FALSE)
all.equal(x %birger.fixed% table, x %birger% table)
# [1] TRUE
microbenchmark(x %birger.fixed% table, x %birger% table, times = 1000, unit = 'relative')
# Unit: relative
# expr min lq mean median uq max neval
# x %birger.fixed% table 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 1000
# x %birger% table 2.059546 2.011009 1.903589 1.913446 1.857798 1.336424 1000
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句