Función vectorizada para dplyr :: mutate ()

Question

Estoy tratando de escribir una función vectorizada para comparar una cadena con un vector de expresiones regulares y devolver VERDADERO si la cadena coincide con alguna de las expresiones regulares. La función debería funcionar en una sola cadena, un vector de cadenas y dentro de dplyr::mutate. Tengo problemas para vectorizar la función. En el siguiente reprex, la función que me gustaría vectorizar es is_favorite. Se me ocurrieron soluciones alternativas usando base::Vectorizey, purrr::mappero estas logran el objetivo. También intenté usar en stringi::stri_detect_regexlugar de lo stringr::str_detectque produjo los mismos resultados.

¡Muchas gracias por tu ayuda!

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

^{Creado el 2020-08-28 por el paquete reprex (v0.3.0)}

También consulté los siguientes recursos:

• 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

anysiempre devolvería solo un valor lógico como salida. Debe contraer su favorite_carsexpresión regular como una cadena de longitud 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)
}

y luego usa:

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
#...
#...

donde el patrón que estamos buscando se convierte en

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