Simultaneously Parallelizing and Vectorizing Code in R [closed] - r

Question

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 2 months ago.
Improve this question
I am working with the R programming language.
I have this dataset that contains consecutive exam results from students over a period of time - I am trying to use this dataset to calculate the conditional probability of a student failing the next exam, given that the student failed the previous exam. The data looks something like this:
library(data.table)
id = sample.int(10000, 100000, replace = TRUE)
res = c(1,0)
results = sample(res, 100000, replace = TRUE)
date_exam_taken = sample(seq(as.Date('1999/01/01'), as.Date('2020/01/01'), by="day"), 100000, replace = TRUE)
my_data = data.frame(id, results, date_exam_taken)
my_data <- my_data[order(my_data$id, my_data$date_exam_taken),]
my_data$general_id = 1:nrow(my_data)
my_data$exam_number = ave(my_data$general_id, my_data$id, FUN = seq_along)
my_data$general_id = NULL
I have been spending some time learning how to "vectorize and parallelize" a function in R that will be able to calculate these conditional probabilities .
My initial code was a FOR LOOP - I was told that "vectorizing" your code allows R to simultaneously perform operations on multiple elements compared to a FOR LOOP which only allows R to perform operations on a single element, thus allowing for an increase in efficiency and a decrease in time/speed. On the other hand, I was told that "parallelizing" can potentially make your code run faster as it allows your computer to allocate more processing power through allocating the task at hand to different "cores" within your computer.
Thus, I tried to exploit both of these principles (vectorizing and parallelizing) and incorporate them both into my code. Furthermore, I was told about the advantages of using the "data.table" library in R and converted my data frame into a "data.table" object for another potential gain in performance.
Here is my attempt:
# First, load the "doParallel" library
library(doParallel)
library(data.table)
# Set up a cluster with 4 cores
cl = makeCluster(4)
registerDoParallel(cl)
my_data = as.data.table(my_data)
# Now, you can use the `foreach` function with the `%dopar%` operator to parallelize the computation
my_vector = foreach(i = unique(my_data$id), .combine = rbind) %dopar% {
{tryCatch({
# Inside the function, everything works the same as before
#setDT(my_data)
start_i = my_data[my_data$id == i,]
pairs_i = data.table(first = head(start_i$results, -1), second = tail(start_i$results, -1))
frame_i = data.table(table(pairs_i))
frame_i$i = i
#print(frame_i)
return(frame_i)
}
, error = function(e){})
}}
# Don't forget to stop the cluster when you're done
stopCluster(cl)
From here, I would then perform a series of JOINS on the results and calculate the different conditional probabilities (pass given pass, pass given fail, fail given fail, fail given pass), and place these results in a 2x2 contingency table.
The code seems to run - but I am interested in knowing if I have done this correctly and what could have been done differently.
Can someone please tell me if I have done this correctly?
Thanks!

Answer 1

This particular problem is not well suited for parallelization. The expense of setting up the cluster exceeds any benefit, especially when a vectorized solution is straightforward.
By sorting the table by id then date_exam_taken, we can get the previous exam result and then drop rows where breaks in id occur.
data.table then allows us to efficiently aggregate by the four combinations of results in order to form the contingency table.
m <- matrix(
setorder(
dt[
# get the results from the previous row (first row is NA)
,res0 := shift(results)
][
# keep only rows that have the same id as the previous row
id == shift(id)
][
# group by the four cases (pass-pass, pass-fail, etc.) and count the occurrences of each
, .N, c("res0", "results")
# sort descending by the current exam, then descending by the previous exam
], -results, -res0
# put the results into a 2x2 matrix
)$N, 2, 2, 0, list(c("pass0", "fail0"), c("pass1", "fail1"))
)
m # 2x2 contingency table by count
#> pass1 fail1
#> pass0 22527 22460
#> fail0 22491 22524
m/rowSums(m) # by proportion pass/fail given the results of the previous exam
#> pass1 fail1
#> pass0 0.5007447 0.4992553
#> fail0 0.4996335 0.5003665
This will be very fast. However, if performance is an overriding concern (as opposed to, e.g., readability), we can squeeze a little more out by using tabulate instead of data.table grouping operations. Put the two solutions in functions and test their performance with microbenchmark.
f1 <- function(dt) {
if (!identical(key(dt), c("id", "date_exam_taken"))) setkey(dt, id, date_exam_taken)
m <- matrix(
setorder(
dt[
,res0 := shift(results)
][
id == shift(id)
][
, .N, c("res0", "results")
], -results, -res0
)$N, 2, 2, 0, list(c("pass0", "fail0"), c("pass1", "fail1"))
)
m/rowSums(m)
}
f2 <- function(dt) {
if (!identical(key(dt), c("id", "date_exam_taken"))) setkey(dt, id, date_exam_taken)
m <- matrix(
with(
dt,
tabulate((shift(id) == id)*(4L - 2L*results - shift(results)), 4L)
), 2, 2, 0, list(c("pass0", "fail0"), c("pass1", "fail1"))
)
m/rowSums(m)
}
microbenchmark::microbenchmark(f1(dt),
f2(dt),
check = "identical")
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> f1(dt) 3.0650 3.9351 4.931590 4.1148 4.63785 12.1386 100
#> f2(dt) 1.5193 1.7114 1.933132 1.7479 1.77500 7.8051 100
Data:
library(data.table)
(seed <- sample(.Machine$integer.max, 1))
#> [1] 1849007255
set.seed(seed)
dt <- data.table(
id = sample.int(10000, 100000, replace = TRUE),
results = sample(0:1, 100000, replace = TRUE),
date_exam_taken = sample(seq(as.Date('1999/01/01'), as.Date('2020/01/01'), by="day"), 100000, replace = TRUE)
)