Add parallel grid creation function and update pqc_to_grid function

R_lib/init_r_lib.R

@@ -1,4 +1,7 @@
-pqc_to_grid <- function(pqc_in, grid) {
+has_foreach <- require(foreach)
+has_doParallel <- require(doParallel)
+
+seq_pqc_to_grid <- function(pqc_in, grid) {
     # Convert the input DataFrame to a matrix
     dt <- as.matrix(pqc_in)
 
@@ -29,6 +32,55 @@ pqc_to_grid <- function(pqc_in, grid) {
     return(res_df)
 }
 
+par_pqc_to_grid <- function(pqc_in, grid) {
+    # Convert the input DataFrame to a matrix
+    dt <- as.matrix(pqc_in)
+
+    # Flatten the matrix into a vector
+    id_vector <- as.vector(t(grid))
+
+    # Initialize an empty matrix to store the results
+    # result_mat <- matrix(nrow = 0, ncol = ncol(dt))
+
+    # Set up parallel processing
+    num_cores <- detectCores()
+    cl <- makeCluster(num_cores)
+    registerDoParallel(cl)
+
+    # Iterate over each ID in the vector in parallel
+    result_mat <- foreach(id_mat = id_vector, .combine = rbind) %dopar% {
+        # Find the matching row in the matrix
+        matching_row <- dt[dt[, "ID"] == id_mat, ]
+
+        # Return the matching row
+        matching_row
+    }
+
+    # Stop the parallel processing
+    stopCluster(cl)
+
+    # Convert the result matrix to a data frame
+    res_df <- as.data.frame(result_mat)
+
+    # Remove all columns which only contain NaN
+    res_df <- res_df[, colSums(is.na(res_df)) != nrow(res_df)]
+
+    # Remove row names
+    rownames(res_df) <- NULL
+
+    return(res_df)
+}
+
+pqc_to_grid <- function(pqc_in, grid) {
+    if (has_doParallel && has_foreach) {
+        print("Using parallel grid creation")
+        return(par_pqc_to_grid(pqc_in, grid))
+    } else {
+        print("Using sequential grid creation")
+        return(seq_pqc_to_grid(pqc_in, grid))
+    }
+}
+
 resolve_pqc_bound <- function(pqc_mat, transport_spec, id) {
     df <- as.data.frame(pqc_mat, check.names = FALSE)
     value <- df[df$ID == id, transport_spec]