Hàm vector hóa cho dplyr :: mutate ()

Question

Tôi đang cố gắng viết một hàm vectơ hóa để so sánh một chuỗi với một vectơ của biểu thức chính quy và trả về TRUE nếu chuỗi khớp với bất kỳ biểu thức chính quy nào. Hàm phải hoạt động trên một chuỗi đơn, một vectơ chuỗi và bên trong dplyr::mutate. Tôi đang gặp sự cố khi vẽ vectơ hàm. Trong reprex dưới đây, chức năng tôi muốn vectơ hóa là is_favorite. Tôi đã nghĩ ra các giải pháp thay thế bằng cách sử dụng base::Vectorizevà purrr::mapnhưng chúng hoàn toàn đạt được mục tiêu. Tôi cũng đã thử sử dụng stringi::stri_detect_regexthay thế stringr::str_detectcho kết quả tương tự.

Cảm ơn rất nhiều vì sự giúp đỡ của bạn!

library(dplyr)
library(tibble)
library(stringr)

favorite_cars <- c("^Merc", "Firebird$") mtcars <- mtcars %>% tibble::rownames_to_column("car") is_favorite <- function(x) { any(stringr::str_detect(x, favorite_cars)) } # Success: Works on single string is_favorite("Merc 240D") #> [1] TRUE is_favorite("Ferrari Dino") #> [1] FALSE # Failure: On vector, returns a single boolean instead of a vector of booleans is_favorite(mtcars$car)
#> [1] TRUE

# Failure: Add column with single boolean instead of vectorized rowwise
mtcars %>% 
  mutate(fav_car = is_favorite(car)) %>% 
  head()
#>                 car  mpg cyl disp  hp drat    wt  qsec vs am gear carb fav_car
#> 1         Mazda RX4 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4    TRUE
#> 2     Mazda RX4 Wag 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4    TRUE
#> 3        Datsun 710 22.8   4  108  93 3.85 2.320 18.61  1  1    4    1    TRUE
#> 4    Hornet 4 Drive 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1    TRUE
#> 5 Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2    TRUE
#> 6           Valiant 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1    TRUE

# Success...but not ideal
# https://community.rstudio.com/t/vectorise-text-function-for-dplyr-mutate/53387/2
# https://deanattali.com/blog/mutate-non-vectorized/
# https://www.jimhester.com/post/2018-04-12-vectorize/
v_is_favorite <- Vectorize(is_favorite)

mtcars %>% 
  mutate(fav_car = v_is_favorite(car)) %>% 
  head()
#>                 car  mpg cyl disp  hp drat    wt  qsec vs am gear carb fav_car
#> 1         Mazda RX4 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4   FALSE
#> 2     Mazda RX4 Wag 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4   FALSE
#> 3        Datsun 710 22.8   4  108  93 3.85 2.320 18.61  1  1    4    1   FALSE
#> 4    Hornet 4 Drive 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1   FALSE
#> 5 Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2   FALSE
#> 6           Valiant 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1   FALSE

# Success...better but still not ideal
# https://www.jimhester.com/post/2018-04-12-vectorize/
# http://yoshidk6.hatenablog.com/entry/2018/09/05/222248
mtcars %>% 
  mutate(fav_car = purrr::map_lgl(car, is_favorite)) %>% 
  head()
#>                 car  mpg cyl disp  hp drat    wt  qsec vs am gear carb fav_car
#> 1         Mazda RX4 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4   FALSE
#> 2     Mazda RX4 Wag 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4   FALSE
#> 3        Datsun 710 22.8   4  108  93 3.85 2.320 18.61  1  1    4    1   FALSE
#> 4    Hornet 4 Drive 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1   FALSE
#> 5 Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2   FALSE
#> 6           Valiant 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1   FALSE

^{Được tạo vào 2020-08-28 bởi gói reprex (v0.3.0)}

Tôi cũng đã tham khảo các nguồn sau:

• https://adv-r.hadley.nz/perf-improve.html#vectorise
• https://deanattali.com/blog/mutate-non-vectorized/
• https://www.jimhester.com/post/2018-04-12-vectorize/
• https://community.rstudio.com/t/vectorise-text-function-for-dplyr-mutate/53387/2
• http://yoshidk6.hatenablog.com/entry/2018/09/05/222248
• https://dplyr.tidyverse.org/articles/programming.html

Answer 1

anysẽ luôn chỉ trả về một giá trị logic làm đầu ra. Bạn nên thu gọn favorite_carsregex của mình dưới dạng chuỗi dài 1.

is_favorite <- function(x) {
  stringr::str_detect(x, paste0(favorite_cars, collapse = "|"))
  #Will also work with base R grepl
  #grepl(paste0(favorite_cars, collapse = "|"), x)
}

và sau đó sử dụng:

library(dplyr)
mtcars %>%  mutate(fav_car = is_favorite(car))

#                   car  mpg cyl  disp  hp drat   wt qsec vs am gear carb fav_car
#1            Mazda RX4 21.0   6 160.0 110 3.90 2.62 16.5  0  1    4    4   FALSE
#2        Mazda RX4 Wag 21.0   6 160.0 110 3.90 2.88 17.0  0  1    4    4   FALSE
#3           Datsun 710 22.8   4 108.0  93 3.85 2.32 18.6  1  1    4    1   FALSE
#4       Hornet 4 Drive 21.4   6 258.0 110 3.08 3.21 19.4  1  0    3    1   FALSE
#5    Hornet Sportabout 18.7   8 360.0 175 3.15 3.44 17.0  0  0    3    2   FALSE
#6              Valiant 18.1   6 225.0 105 2.76 3.46 20.2  1  0    3    1   FALSE
#7           Duster 360 14.3   8 360.0 245 3.21 3.57 15.8  0  0    3    4   FALSE
#8            Merc 240D 24.4   4 146.7  62 3.69 3.19 20.0  1  0    4    2    TRUE
#9             Merc 230 22.8   4 140.8  95 3.92 3.15 22.9  1  0    4    2    TRUE
#10            Merc 280 19.2   6 167.6 123 3.92 3.44 18.3  1  0    4    4    TRUE
#11           Merc 280C 17.8   6 167.6 123 3.92 3.44 18.9  1  0    4    4    TRUE
#...
#...

nơi mà mô hình mà chúng tôi đang tìm kiếm trở thành

paste0(favorite_cars, collapse = "|")
#[1] "^Merc|Firebird$"