mirror of
https://git.gfz-potsdam.de/naaice/poet.git
synced 2025-12-15 12:28:22 +01:00
113 lines
3.5 KiB
R
113 lines
3.5 KiB
R
### Copyright (C) 2018-2024 Marco De Lucia, Max Luebke (GFZ Potsdam, University of Potsdam)
|
|
###
|
|
### POET is free software; you can redistribute it and/or modify it under the
|
|
### terms of the GNU General Public License as published by the Free Software
|
|
### Foundation; either version 2 of the License, or (at your option) any later
|
|
### version.
|
|
###
|
|
### POET is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
### WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
|
|
### A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
|
###
|
|
### You should have received a copy of the GNU General Public License along with
|
|
### this program; if not, write to the Free Software Foundation, Inc., 51
|
|
### Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
|
|
##' @param pqc_mat matrix, containing IDs and PHREEQC outputs
|
|
##' @param grid matrix, zonation referring to pqc_mat$ID
|
|
##' @return a data.frame
|
|
# pqc_to_grid <- function(pqc_mat, grid) {
|
|
# # Convert the input DataFrame to a matrix
|
|
# pqc_mat <- as.matrix(pqc_mat)
|
|
|
|
# # Flatten the matrix into a vector
|
|
# id_vector <- as.integer(t(grid))
|
|
|
|
# # Find the matching rows in the matrix
|
|
# row_indices <- match(id_vector, pqc_mat[, "ID"])
|
|
|
|
# # Extract the matching rows from pqc_mat to size of grid matrix
|
|
# result_mat <- pqc_mat[row_indices, ]
|
|
|
|
# # 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)
|
|
# }
|
|
|
|
##' @param pqc_mat matrix, containing IDs and PHREEQC outputs
|
|
##' @param grid matrix, zonation referring to pqc_mat$ID
|
|
##' @return a data.frame
|
|
pqc_to_grid <- function(pqc_mat, grid) {
|
|
# Convert the input DataFrame to a matrix
|
|
pqc_mat <- as.matrix(pqc_mat)
|
|
|
|
# Flatten the matrix into a vector
|
|
id_vector <- as.integer(t(grid))
|
|
|
|
# Find the matching rows in the matrix
|
|
row_indices <- match(id_vector, pqc_mat[, "ID"])
|
|
|
|
# Extract the matching rows from pqc_mat to size of grid matrix
|
|
result_mat <- pqc_mat[row_indices, ]
|
|
|
|
# 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)
|
|
}
|
|
|
|
|
|
##' @param pqc_mat matrix,
|
|
##' @param transport_spec column name of species in pqc_mat
|
|
##' @param id
|
|
##' @title
|
|
##' @return
|
|
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]
|
|
|
|
if (is.nan(value)) {
|
|
value <- 0
|
|
}
|
|
|
|
return(value)
|
|
}
|
|
|
|
##' @title
|
|
##' @param init_grid
|
|
##' @param new_names
|
|
##' @return
|
|
add_missing_transport_species <- function(init_grid, new_names) {
|
|
# add 'ID' to new_names front, as it is not a transport species but required
|
|
new_names <- c("ID", new_names)
|
|
sol_length <- length(new_names)
|
|
|
|
new_grid <- data.frame(matrix(0, nrow = nrow(init_grid), ncol = sol_length))
|
|
names(new_grid) <- new_names
|
|
|
|
matching_cols <- intersect(names(init_grid), new_names)
|
|
|
|
# Copy matching columns from init_grid to new_grid
|
|
new_grid[, matching_cols] <- init_grid[, matching_cols]
|
|
|
|
|
|
# Add missing columns to new_grid
|
|
append_df <- init_grid[, !(names(init_grid) %in% new_names)]
|
|
new_grid <- cbind(new_grid, append_df)
|
|
|
|
return(new_grid)
|
|
}
|