max/poet
1
0
Fork 0
mirror of https://git.gfz-potsdam.de/naaice/poet.git synced 2025-12-16 12:54:50 +01:00
Code Issues Packages Projects Releases Wiki Activity

Refactor code for grid creation and result storage

Browse Source
This commit is contained in:
Max Luebke 2024-04-08 11:27:06 +00:00
parent 4fa935475e
commit af48694d22
1 changed files with 3 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
R_lib/init_r_lib.R
View File

@ -1,29 +1,16 @@
has_foreach <- require(foreach) pqc_to_grid <- function(pqc_in, grid) {
has_doParallel <- require(doParallel)
seq_pqc_to_grid <- function(pqc_in, grid) {
# Convert the input DataFrame to a matrix # Convert the input DataFrame to a matrix
pqc_in <- as.matrix(pqc_in) pqc_in <- as.matrix(pqc_in)
# Flatten the matrix into a vector # Flatten the matrix into a vector
id_vector <- as.numeric(t(grid)) id_vector <- as.numeric(t(grid))
# Initialize an empty matrix to store the results # Find the matching rows in the matrix
# result_mat <- matrix(NA, nrow = length(id_vector), ncol = ncol(pqc_in))
row_indices <- match(id_vector, pqc_in[, "ID"]) row_indices <- match(id_vector, pqc_in[, "ID"])
# Extract the matching rows from pqc_in to size of grid matrix
result_mat <- pqc_in[row_indices, ] result_mat <- pqc_in[row_indices, ]
# Iterate over each ID in the vector
# for (i in seq_along(id_vector)) {
# # Find the matching row in the matrix
# # matching_row <- pqc_in[pqc_in[, "ID"] == i, ]
# # Append the matching row to the result matrix
# result_mat[i, ] <- pqc_in[pqc_in[, "ID"] == i, ]
# }
# Convert the result matrix to a data frame # Convert the result matrix to a data frame
res_df <- as.data.frame(result_mat) res_df <- as.data.frame(result_mat)
@ -36,55 +23,6 @@ seq_pqc_to_grid <- function(pqc_in, grid) {
return(res_df) 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) { resolve_pqc_bound <- function(pqc_mat, transport_spec, id) {
df <- as.data.frame(pqc_mat, check.names = FALSE) df <- as.data.frame(pqc_mat, check.names = FALSE)
value <- df[df$ID == id, transport_spec] value <- df[df$ID == id, transport_spec]