Merge branch '70-bugfix-value_prj_ph_medium' into 'master'

[bugfix] make all OGS6 benchmarks work.

Closes #70, #63, and #60

See merge request !54

.Rbuildignore

@@ -10,6 +10,7 @@
 ^inst/examples/Theis_well_pumping
 ^JOSS$
 ^LICENSE.md
+^local-bm-test$
 ^Meta$
 ^packrat/
 ^public$

DESCRIPTION

 Package: r2ogs6
 Type: Package
 Title: An API to the multi-physics simulator OpenGeoSys-v6
-Version: 0.2.0
+Version: 0.6.41
 Authors@R: c(person(given = "Ruben",
                     family = "Heinrich",
                     role = c("aut"),
@@ -33,27 +33,22 @@ Suggests:
     devtools,
     ggplot2,
     BiocManager,
-    rhdf5
+    rhdf5,
+    rmarkdown
 Imports: 
-    purrr,
     xml2,
     tibble,
     R6,
     stringr,
-    readr,
     assertthat,
     crayon,
     utils,
-    rmarkdown,
-    curl,
     dplyr,
-    rlang,
     doParallel,
     reticulate,
     config,
-    sticky,
     foreach
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.1
 VignetteBuilder: knitr
 Depends: 
     R (>= 2.10)

NAMESPACE

@@ -67,4 +67,11 @@ export(prj_time_stepping)
 export(prj_tl_process)
 export(prj_vtkdiff)
 export(read_in_prj)
+importFrom(R6,R6Class)
+importFrom(crayon,green)
+importFrom(crayon,red)
+importFrom(crayon,yellow)
+importFrom(doParallel,registerDoParallel)
+importFrom(dplyr,bind_cols)
+importFrom(dplyr,bind_rows)
 importFrom(foreach,"%dopar%")

R/export_utils.R

@@ -42,9 +42,16 @@ to_node <- function(object, object_name = "",
         object_name %in% attribute_names))){
 
         if(object_name %in% flatten_on_exp){
+            if(is.list(object)){
+                ret_list <- list(list(list(paste(object, collapse = " "))))
+                names(ret_list)[[1]] <- object_name
+                names(ret_list[[1]])[[1]] <- names(object)[[1]]
+            }else{
                 ret_list <- list(list(paste(object, collapse = " ")))
                 names(ret_list)[[1]] <- object_name
-                return(invisible(ret_list))
+            }
+
+            return(invisible(ret_list))
         }
 
         if(object_name %in% attribute_names){
@@ -154,6 +161,10 @@ to_node <- function(object, object_name = "",
 
         for(i in seq_len(length(object))){
 
+            if(is.null(object[[i]])){
+                next
+            }
+
             element_name <- names(object)[[i]]
 
             element_node <- to_node(object[[i]],

R/generate_benchmark_script.R

@@ -399,7 +399,7 @@ construct_add_call <- function(object, nested_call = FALSE) {
     }
 
     #For lists we need to use recursion
-    if(class(object) == "list"){
+    if(inherits(object, "list")){
 
         element_strs <- lapply(object, function(x){construct_add_call(x, TRUE)})
 

R/ogs6.R

@@ -5,6 +5,7 @@
 #' OGS6
 #' @description Constructor for the \code{OGS6} base class
 #' @export
+#' @importFrom R6 R6Class
 OGS6 <- R6::R6Class("OGS6",
   public = list(
 
@@ -171,6 +172,9 @@ OGS6 <- R6::R6Class("OGS6",
     #' @examples
     #' ogs6_obj <- OGS6$new(sim_name = "my_sim", sim_path = "my/path")
     #' ogs6_obj$get_status()
+    #' @importFrom crayon red
+    #' @importFrom crayon yellow
+    #' @importFrom crayon green
     get_status = function(print_status = TRUE){
 
       assertthat::assert_that(assertthat::is.flag(print_status))

R/ogs6_chain.R

@@ -5,6 +5,7 @@
 #'OGS6_Chain
 #'@description Constructor for the OGS6_Chain base class
 #'@export
+#' @importFrom R6 R6Class
 OGS6_Chain <- R6::R6Class(
     "OGS6_Chain",
 

R/ogs6_ensemble.R

@@ -100,6 +100,7 @@ OGS6_Ensemble <- R6::R6Class(
         #' This is implementented via the 'parallel' package.
         #' @param overwrite flag: Should existing files be overwritten?
         #'@param verbose flag
+        #'@importFrom doParallel registerDoParallel
         run_simulation = function(parallel = FALSE,
                                   overwrite = T,
                                   verbose = F){
@@ -186,6 +187,7 @@ OGS6_Ensemble <- R6::R6Class(
         #' Defaults to first timestep.
         #'@param end_at_timestep number: Optional: Timestep to end at. Defaults
         #' to last timestep.
+        #'@importFrom dplyr bind_rows
         get_point_data = function(pvd_id = 1,
                                   point_ids,
                                   keys,

R/ogs6_gml.R

@@ -24,6 +24,7 @@
 #'     ))
 #' )
 #' @export
+#' @importFrom R6 R6Class
 OGS6_gml <- R6::R6Class(
     "OGS6_gml",
     public = list(

R/ogs6_h5.R

@@ -3,6 +3,7 @@
 #' OGS6_h5
 #' @description Small class to wrap \code{h5} data into the \code{r2ogs6} workflow.
 #' @export
+#' @importFrom R6 R6Class
 OGS6_h5 <- R6::R6Class("OGS6_h5",
     public = list(
         #' @description This function will be called automatically after a
@@ -78,6 +79,7 @@ OGS6_h5 <- R6::R6Class("OGS6_h5",
         #' ogs6_h5 <- OGS6_h5$new(h5_path)
         #' df <- ogs6_h5$get_df("/t_0", "pressure")
         #' \dontrun{df <- ogs6_obj$h5s[[1]]$get_df("/t_0", "pressure")}
+        #' @importFrom dplyr bind_cols
         get_df = function(group, names = "geometry") {
 
             assertthat::is.string(group)

R/ogs6_msh.R

@@ -3,6 +3,7 @@
 #' MSH files are a legacy format from OGS5. It is recommended to switch to VTU
 #'  files.
 #' @export
+#' @importFrom R6 R6Class
 OGS6_msh <- R6::R6Class("OGS6_msh",
     public = list(
         #' @description reates new OGS6_vtu object..

R/ogs6_pvd.R

@@ -5,6 +5,7 @@
 #' OGS6_pvd
 #' @description Constructor for the OGS6_pvd base class
 #' @export
+#' @importFrom R6 R6Class
 OGS6_pvd <- R6::R6Class(
     "OGS6_pvd",
     public = list(
@@ -260,6 +261,7 @@ OGS6_pvd <- R6::R6Class(
         },
 
         # Returns a dataframe with all of the CellData
+        #' @importFrom dplyr bind_rows
         get_data = function(data_type,
                             ids,
                             keys,

R/ogs6_vtu.R

@@ -5,6 +5,7 @@
 #' OGS6_vtu
 #' @description Constructor for the `OGS6_vtu` base class
 #' @export
+#' @importFrom R6 R6Class
 OGS6_vtu <- R6::R6Class(
     "OGS6_vtu",
     public = list(
@@ -244,7 +245,7 @@ OGS6_vtu <- R6::R6Class(
     ),
 
     private = list(
-
+        #' @importFrom dplyr bind_rows
         get_data = function(data_type,
                             ids,
                             keys){

R/prj_curve.R

@@ -12,7 +12,7 @@
 #' @export
 prj_curve <- function(name, coords, values){
 
-    #Coerce input
+    if(missing(name)){ name <- NULL }
     coords <- coerce_string_to_numeric(coords)
     values <- coerce_string_to_numeric(values)
 
@@ -22,14 +22,21 @@ prj_curve <- function(name, coords, values){
 
 new_prj_curve <- function(name, coords, values){
 
-    assertthat::assert_that(assertthat::is.string(name))
+    if(!is.null(name)){
+        assertthat::assert_that(assertthat::is.string(name))
+    }
     assertthat::assert_that(is.numeric(coords))
     assertthat::assert_that(is.numeric(values))
 
     structure(list(name = name,
                    coords = coords,
                    values = values,
-                   xpath = "curves/curve",
+                   xpath = c("curves/curve",
+                             paste0("processes/process/porous_medium/",
+                                    "porous_medium/capillary_pressure/curve"),
+                             paste0("processes/process/material_property/",
+                             "porous_medium/porous_medium/",
+                             "capillary_pressure/curve")),
                    attr_names = character(),
                    flatten_on_exp = c("coords", "values")
                    ),

R/prj_medium.R

@@ -422,6 +422,8 @@ get_valid_phase_types <- function(){
 #' @param exponents Optional:
 #' @param lower_saturation_limit Optional:
 #' @param upper_saturation_limit Optional:
+#' @param tortuosity Optional:
+#' @param curve Optional:
 #' @param ... independent_variable, dvalue
 #' @example man/examples/ex_prj_ph_property.R
 #' @export
@@ -436,6 +438,8 @@ prj_ph_property <- function(name,
                             exponents = NULL,
                             lower_saturation_limit = NULL,
                             upper_saturation_limit = NULL,
+                            tortuosity = NULL,
+                            curve = NULL,
                             ...) {
 
     #Coerce input
@@ -449,6 +453,7 @@ prj_ph_property <- function(name,
     swelling_pressures <- coerce_string_to_numeric(swelling_pressures)
     lower_saturation_limit <- coerce_string_to_numeric(lower_saturation_limit)
     upper_saturation_limit <- coerce_string_to_numeric(upper_saturation_limit)
+    tortuosity <- (coerce_string_to_numeric(tortuosity))
 
     ellipsis_list <- list(...)
     independent_variable <-
@@ -467,7 +472,9 @@ prj_ph_property <- function(name,
                         swelling_pressures,
                         exponents,
                         lower_saturation_limit,
-                        upper_saturation_limit)
+                        upper_saturation_limit,
+                        tortuosity,
+                        curve)
 }
 
 
@@ -483,7 +490,9 @@ new_prj_ph_property <- function(name,
                                 swelling_pressures = NULL,
                                 exponents = NULL,
                                 lower_saturation_limit = NULL,
-                                upper_saturation_limit = NULL) {
+                                upper_saturation_limit = NULL,
+                                tortuosity = NULL,
+                                curve = NULL) {
 
     are_strings(name,
                 type)
@@ -506,22 +515,23 @@ new_prj_ph_property <- function(name,
         reference_value,
         offset,
         lower_saturation_limit,
-        upper_saturation_limit
+        upper_saturation_limit,
+        tortuosity
     )
 
     are_null_or_numeric(swelling_pressures,
                         exponents)
 
-    are_null_or_strings(parameter_name)
+    are_null_or_strings(parameter_name, curve)
 
-    if (!is.null(independent_variable)) {
-        independent_variable <- lapply(independent_variable, function(x){
-            x <- coerce_names(x,
-                              c("variable_name",
-                                "reference_condition",
-                                "slope"))
-        })
-    }
+    # if (!is.null(independent_variable)) {
+    #     independent_variable <- lapply(independent_variable, function(x){
+    #         x <- coerce_names(x,
+    #                           c("variable_name",
+    #                             "reference_condition",
+    #                             "slope"))
+    #     })
+    # }
 
     if (!is.null(exponent)) {
         exponent <- coerce_names(exponent,
@@ -543,9 +553,11 @@ new_prj_ph_property <- function(name,
                    exponents = exponents,
                    lower_saturation_limit = lower_saturation_limit,
                    upper_saturation_limit = upper_saturation_limit,
+                   tortuosity = tortuosity,
+                   curve = curve,
                    xpath = "media/medium/phases/phase/properties/property",
                    attr_names = character(),
-                   flatten_on_exp = c("exponents",
+                   flatten_on_exp = c("value", "exponents",
                                       "swelling_pressures"),
                    unwrap_on_exp = c("independent_variable", "dvalue")
     ),

R/prj_porous_medium.R

@@ -144,16 +144,6 @@ new_prj_capillary_pressure <- function(type,
 
     are_null_or_string_flags(has_regularized)
 
-    is_null_or_coerce_names(curve, c("coords", "values"))
-
-    if(!is.null(curve)){
-        curve[[1]] <- coerce_string_to_numeric(curve[[1]])
-        curve[[2]] <- coerce_string_to_numeric(curve[[2]])
-
-        assertthat::assert_that(is.numeric(curve[[1]]))
-        assertthat::assert_that(is.numeric(curve[[2]]))
-    }
-
     structure(list(type = type,
                    pd = pd,
                    sr = sr,

R/prj_process.R

@@ -1012,7 +1012,8 @@ new_prj_jacobian_assembler <- function(type,
                    relative_epsilons = relative_epsilons,
                    xpath = "processes/process/jacobian_assembler",
                    attr_names = character(),
-                   flatten_on_exp = character()
+                   flatten_on_exp = c("component_magnitudes",
+                                      "relative_epsilons")
     ),
     class = "prj_jacobian_assembler"
     )

R/read_in_prj.R

@@ -59,8 +59,9 @@ read_in_prj <- function(ogs6_obj,
 
     for(i in seq_along(vtu_ref_nodes)){
         vtu_ref <- xml2::xml_text(vtu_ref_nodes[[i]])
+        vtu_ref <- stringr::str_trim(vtu_ref)
+        vtu_ref <- stringr::str_remove_all(vtu_ref, "[\n]")
         vtu_path <- make_abs_path(vtu_ref, prj_base_path)
-        # vtu_path <- paste0(dirname(prj_path), "/", vtu_ref)
 
         axisym_val <- xml2::xml_attr(vtu_ref_nodes[[i]], "axially_symmetric")
 

R/read_in_utils.R

@@ -177,15 +177,15 @@ node_to_object <- function(xml_node,
 
         xml_attrs <- xml2::xml_attrs(xml_node)
         xml_text <- xml2::xml_text(xml_node)
-
+        xml_text_clean <- stringr::str_trim(xml_text)
         xml_text_clean <-
-            stringr::str_remove_all(xml_text, "[\n|[:space:]]")
+            stringr::str_remove_all(xml_text_clean, "[\n]")
 
         if(xml_text_clean != "" && length(xml_attrs) != 0){
-            return(invisible(c(xml_attrs, xml_text = xml_text)))
+            return(invisible(c(xml_attrs, xml_text = xml_text_clean)))
         }
         else if(xml_text_clean != ""){
-            return(invisible(xml_text))
+            return(invisible(xml_text_clean))
         }
         else if(length(xml_attrs) != 0){
             return(invisible(xml_attrs))

data-raw/xpaths_for_classes.R

@@ -8,11 +8,11 @@
 #' requires string parsing.
 get_xpaths_for_classes <- function(){
 
-    ns_exports <- getNamespaceExports("r2ogs6")
+    all_objects <- ls("package:r2ogs6")
     prj_class_constructor_names <-
-        sort(ns_exports[grepl("^new_prj_", ns_exports)])
+        sort(all_objects[grepl("^new_prj_", all_objects)])
     prj_class_helper_names <-
-        sort(ns_exports[grepl("^prj_", ns_exports)])
+        sort(all_objects[grepl("^prj_", all_objects)])
 
     xfc_list <- list()