From 0cf6d6512848cbf4cde8d772cadab0a265e55a52 Mon Sep 17 00:00:00 2001
From: Max Luebke <mluebke@gfz-potsdam.de>
Date: Wed, 3 Apr 2024 14:24:23 +0000
Subject: [PATCH] Add parallel grid creation function and update pqc_to_grid
 function

---
 R_lib/init_r_lib.R | 54 +++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 53 insertions(+), 1 deletion(-)

diff --git a/R_lib/init_r_lib.R b/R_lib/init_r_lib.R
index a33a3adba..f6b433b42 100644
--- a/R_lib/init_r_lib.R
+++ b/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]