How to parallelize gsub currently in a for loop in R?

Question

I'm fairly new to trying to run parallel processes in R because most of the data I work with just isn't that large. However, I am no working with a larger set of data where I am attempting to 'find and replace' a set of about 2000 names from 9000 survey comments. I've created a for loop using gsub that gets the job done, but it takes quite a long time:

completed <- 0

for (name in names){
  text_df$text <- sapply(text_df$text, gsub, pattern=paste0("(?<=\\W|^)", name, "(?=\\W|$)"), replacement="RemovedLeader", ignore.case=TRUE, perl=TRUE)
  completed <- completed + 1
  print(paste0("Completed ", completed," out of ", length(names)))
} 

From what I understand, this should be a fairly simple process to run in parallel, yet I'm having a bit of trouble. I've tried running this using parSapply, but I'm having a hard time re-writing the gsub (which itself is currently in an sapply in the for loop) to work outside of the for loop. Thanks for the help.

Answer 1

This is not a task for parallelization yet. Since you have to reapply again and again the name replacements.

apply-Family functions are using lists and lists are very slow in R.

Avoid lists, by using vectorization.

In this special case I would advise: Gain speed by putting all speed work to the regex module. E.g. take the 200 names and put them into one regex search pattern.

names <- c("a", "b", "c", "d", "e")
texts <- c("this is a thing", "a b and an a", "this is a c cat", "B c d acd", "e A e ead")

# one regex pattern to replace all names at once
pattern = paste0("(?<=\\W|^)(", paste(names, collapse="|"), ")(?=\\W|$)")

# use regex's speed
gsub(pattern = pattern, replacement = "RemovedLeader", x = texts, ignore.case = TRUE, perl = TRUE)

# [1] "this is RemovedLeader thing"                     
# [2] "RemovedLeader RemovedLeader and an RemovedLeader"
# [3] "this is RemovedLeader RemovedLeader cat"         
# [4] "RemovedLeader RemovedLeader RemovedLeader acd"   
# [5] "RemovedLeader RemovedLeader RemovedLeader ead" 

Parallelize using parallel package

Just to demonstrate you how you would solve this problem with parallelization:

names <- c("a", "b", "c", "d", "e")
texts <- c("this is a thing", "a b and an a", "this is a c", "B c d", "e A e")

# Before parallelization, think about over which sequence
# you can parallelize this procedure - which components in a sequence
# are independent?

# In this case the single strings of the texts are independent from each other.

# so write a function for one string to be fully processed as desired.

# let's define a function which applies the name replacements on one text piece.
replace_names <- function(names, string) {
    for (name in names) {
        string <- gsub(pattern = paste0("(?<=\\W|^)", name, "(?=\\W|$)"),
                       x = string,
                       replacement = "RemovedLeader",
                       ignore.case = TRUE,
                       perl = TRUE)
    }
    string
}

# Let us then apply this replacement for one string
# over the entire texts vector - for your case: `texts = text_df$texts`

# 0. load the `parallel` package
require(parallel) # install.packages("parallel")

# 1. prepare a cluster
cl <- parallel::makeCluster(parallel::detectCores() - 1)

# 2. export all variables and functions needed for the calculation to cluster
parallel::clusterExport(cl=cl, varlist=list(replace_names = "replace_names",
                                              names = "names",
                                              texts = "texts"))

# 3. run and get results type in console: `parallel::` and then TAB to see all
# available functions
# use `?<functionname>` and RET to see more details about the functions
new_texts <- parallel::parSapply(cl, texts, function(txt) replace_names(names, txt))

# 4. don't forget to stop the cluster to give resources free
stopCluster(cl = cl)

The output:

                                   this is a thing 
                     "this is RemovedLeader thing" 
                                      a b and an a 
"RemovedLeader RemovedLeader and an RemovedLeader" 
                                   this is a c cat 
         "this is RemovedLeader RemovedLeader cat" 
                                         B c d acd 
   "RemovedLeader RemovedLeader RemovedLeader acd" 
                                         e A e ead 
   "RemovedLeader RemovedLeader RemovedLeader ead" 

So you can basically parallelize over the single strings in the text-vector.

Parallelize using foreach-doParallel-parallel packages (no export of variable and functions required - better for automatization)

names <- c("a", "b", "c", "d", "e")
texts <- c("this is a thing", "a b and an a", "this is a c", "B c d", "e A e")

replace_names <- function(names, string) {
    for (name in names) {
        string <- gsub(pattern = paste0("(?<=\\W|^)", name, "(?=\\W|$)"),
                       x = string,
                       replacement = "RemovedLeader",
                       ignore.case = TRUE,
                       perl = TRUE)
    }
    string
}

# 0. load the `parallel` package
require(parallel) # install.packages("parallel")
require(doParallel)
require(foreach)

# 1. prepare a cluster and register it for doParallel
cl <- parallel::makeCluster(parallel::detectCores() - 1)
registerDoParallel(cl) # no need for exporting variables!

# 2. run foreach and %dopar%
new_texts <- foreach::foreach(txt=texts) %dopar% replace_names(names, txt)
# rule for combining result can be given -> instead as list, bind result with `c` to a vector:
new_texts_vec <- foreach::foreach(txt=texts, .combine=`c`) %dopar% replace_names(names, txt)

# 3. don't forget to stop the cluster to give resources free
parallel::stopCluster(cl = cl)

Abstraction over parallelization using foreach and doParallel packages

####################
# define papply
####################

papply <- function(sequential, 
                   monadic_func,
                   exclude_cores=1, 
                   cores=NULL,
                   ...) {
    # prepare cluster
    cl <- parallel::makeCluster(
        if (is.null(cores)) {
            parallel::detectCores() - exclude_cores
        } else {
            cores
        })
    # register
    registerDoParallel(cl)
    # run job
    res <- foreach::`%dopar%`(foreach::foreach(x=sequential, ...), 
                              do.call(monadic_func, list(x)))
    parallel::stopCluster(cl=cl)
    res
}

###################
# define p_star_apply
###################

p_star_apply <- function(list_of_args_list,
                         multiadic_func, 
                         exclude_cores=1,
                         cores=NULL,
                         ...) {
    # prepare cluster
    cl <- parallel::makeCluster(
        if (is.null(cores)) {
            parallel::detectCores() - exclude_cores
        } else {
            cores
        })
    # register
    registerDoParallel(cl)
    # run job
    res <- foreach::`%dopar%`(foreach::foreach(argsl=list_of_args_list, ...), 
                              do.call(multiadic_func, argsl))
    parallel::stopCluster(cl=cl)
    res
} # works!

You can use it like this:

###################
# usage papply 
# - for parallelization of a monadic function
# - arguments can be any type of sequence
# - define by .combine=`list` or .combine=`c` 
#   whether output bound to a list or a vector e.g.
###################

# prepare monadic function (=takes exactly 1 necessary arguments)
replace_names <- function(string, .names=names) {
    for (name in .names) {
        string <- gsub(pattern = paste0("(?<=\\W|^)", name, "(?=\\W|$)"),
                       x = string,
                       replacement = "RemovedLeader",
                       ignore.case = TRUE,
                       perl = TRUE)
    }
    string
}

# call papply by giving for sequential the sequence of arguments
# and for monadic_func the appropriate monadic function:
papply(sequential = texts,
       monadic_func = replace_names,
       .export="names", # this is necessary for replace_names' default argument
       .combine=`c`) # this makes results be bound as vector

# for the `...` argument consult documentation by ?foreach::foreach

And p_star_apply a more universal form, where multiple arguments are successively given to a function, allowing a lot of freedom. Just that the arguments in the correct order are packed into a list of lists.

###################
# usage p_star_apply
# - for parallelization of multiadic functions
# - arguments must be ordered as list or argument lists
#   named or unnamed (if unnamed, argument order must be correct)
# - define by .combine=`list` or .combine=`c` 
#   whether output bound to a list or a vector e.g.
###################

# prepare multiadic function
# in this case dyadic (takes 2 necessary arguments)
dyadic_replace_names <- function(string, .names) {
    for (name in .names) {
        string <- gsub(pattern = paste0("(?<=\\W|^)", name, "(?=\\W|$)"),
                       x = string,
                       replacement = "RemovedLeader",
                       ignore.case = TRUE,
                       perl = TRUE)
    }
    string
}

# prepare list of arguments lists 
# (named elements or unnamed if in correct order)
argsl_lists <- lapply(texts, function(t) list(t, names))

p_star_apply(list_of_args_list=argsl_lists,
             multiadic_func=dyadic_replace_names) # returns as list

p_star_apply(list_of_args_list=argsl_lists,
             multiadic_func=dyadic_replace_names,
             .combine=`c`) # returns as vectors
# showing that `dot-dot-dot` artument, capable to forward the
# arguments for the `foreach()` part!