问使用带有的pmap将不同的正则表达式应用于tibble中的不同变量？

EN

# alternative with data.table
library(data.table)
library(dplyr)

# objects
test_config <-  dplyr::tibble(
  string_col = c("col1", "col2", "col4", "col3"),
  pattern = c("^\\.$", "^NA$", "^$", "^NULL$"),
  replacement = c("","","", "")
)
test_target <- dplyr::tibble(
  col1 = c("Foo", "bar", ".", "NA", "NULL"),
  col2 = c("Foo", "bar", ".", "NA", "NULL"),
  col3 = c("Foo", "bar", ".", "NA", "NULL"),
  col4 = c("NULL", "NA", "Foo", ".", "bar"),
  col5 = c("I", "am", "not", "changing", ".")
)

multiColStringReplace <- function(test_target, test_config){

  # data.table conversion
  test_target <- as.data.table(test_target)
  test_config <- as.data.table(test_config)

  # adding an id column, as I'm reshaping the data, helps for identification of rows
  # throughout the process
  test_target[,id:=1:.N]

  # wide to long format
  test_target2 <- melt(test_target, id.vars="id")
  head(test_target2)

  # pull in the configuration, can join up on one column now
  test_target2 <- merge(test_target2, test_config, by.x="variable",
                        by.y="string_col", all.x=TRUE)

  # this bit still looks messy to me, haven't used pmap before.
  # I've had to subset the data to the required format, run the pmap with gsub
  # to complete the task, then assign the unlisted vector back in to the original
  # data. Would like to see a better option too!
  test_target2[, result := value]
  test_target2[!is.na(pattern), result := gsub(pattern, replacement, value),
               by = .(id, variable)]

  # case from long to original format, and drop the id
  output <- dcast(test_target2, id~variable,
                  value.var = "result")
  output[, id := NULL]

  # back to tibble
  output <- as_tibble(output)

  return(output)

}

output <- multiColStringReplace(test_target, test_config)
output

result <- dplyr::tibble(
  col1 = c("Foo", "bar", "", "NA", "NULL"),
  col2 = c("Foo", "bar", ".", "", "NULL"),
  col3 = c("Foo", "bar", ".", "NA", ""),
  col4 = c("NULL", "NA", "Foo", ".", "bar"),
  col5 = c("I", "am", "not", "changing", ".")
)
output == result

# compare with old method
old <- test_target
for (i in seq(nrow(test_config))) {
  old <- dplyr::mutate_at(old,
                          .vars = dplyr::vars(
                            tidyselect::matches(test_config$string_col[[i]])),
                          .funs = dplyr::funs(
                            stringr::str_replace_all(
                              ., test_config$pattern[[i]], 
                              test_config$replacement[[i]]))
  )
}
old == result

# speed improves, but complexity rises
microbenchmark::microbenchmark("old" = {
  old <- test_target
  for (i in seq(nrow(test_config))) {
    old <- dplyr::mutate_at(old,
                            .vars = dplyr::vars(
                              tidyselect::matches(test_config$string_col[[i]])),
                            .funs = dplyr::funs(
                              stringr::str_replace_all(
                                ., test_config$pattern[[i]], 
                                test_config$replacement[[i]]))
    )
  }
},
"data.table" = {
  multiColStringReplace(test_target, test_config)
}, times = 20)

purrr::pmap_dfr(
  list(list(test_target),
       test_config$string_col,
       test_config$pattern,
       test_config$replacement),
  testFun
) %>% dplyr::distinct()

Unit: milliseconds
          expr       min        lq      mean    median        uq      max neval
          loop 14.808278 16.098818 17.937283 16.811716 20.438360 24.38021    20
 pmap_function  9.486146 10.157526 10.978879 10.628205 11.112485 15.39436    20
     nice_tidy  8.313868  8.633266  9.597485  8.986735  9.870532 14.32946    20
  awkward_tidy  1.535919  1.639706  1.772211  1.712177  1.783465  2.87615    20
    data.table  5.611538  5.652635  8.323122  5.784507  6.359332 51.63031    20