[base] add h5 files after simulation

R/ogs6.R

@@ -601,6 +601,19 @@ OGS6 <- R6::R6Class("OGS6",
           is_wrapper_list(value, "OGS6_pvd")
           private$.pvds <- value
         }
+      },
+
+      #' @field h5
+      #' \code{h5} \code{vaue} must be of class \code{H5IdComponent} as returned
+      #' by \code{rhdf5::H5Fopen()}
+      h5s = function(value) {
+          if(missing(value)) {
+              private$.h5s
+          }else{
+              is_wrapper_list(value, element_class = "OGS6_h5")
+              private$.h5s <- value
+          }
+
       }
   ),
 
@@ -643,7 +656,8 @@ OGS6 <- R6::R6Class("OGS6",
       .insitu = NULL,
 
       # .pvd objects (output)
-      .pvds = NULL
+      .pvds = NULL,
+      .h5s = NULL
   )
 )
 

R/ogs6_h5.R

+
+
+#' OGS6_h5
+#' @description Small class to wrap \code{h5} data into the \cde{r2ogs6} workflow.
+#' @export
+OGS6_h5 <- R6::R6Class("OGS6_h5",
+    public = list(
+        #' @describtion This function will be used after a simulation is run to
+        #' give an overview of the \code{h5} output data.
+        initialize = function(h5_path) {
+
+            assertthat::is.string(h5_path)
+            assertthat::assert_that(file.exists(h5_path))
+            private$h5_info <- rhdf5::h5ls(h5_path)
+            private$h5_path <- h5_path
+
+        },
+        #' @description Overrides the default print method
+        print = function(){
+            cat("OGS6_h5\n")
+            cat("h5 path:\n")
+            cat(private$h5_path, "\n\n")
+            cat("# h5 file structure",
+                paste0(rep("-", cli::console_width() - 20), collapse = ""),
+                "\n")
+            print(private$h5_info)
+        },
+        #' @desctiption return a h5 object for further processing with the
+        #' \code{rhdf5} package.
+        #' @param name Optional: *character* that indicates the element of the h5
+        #' file to access. Default *"/"* will return the entire \code{rhdf5} object.
+        #' @param ... Optional: Further arguments to be passed to the function
+        #' \code{h5read}.
+        #' @value A list of data elements or the element acessed with \code{name}
+        get_h5 = function(name = "/", ...) {
+            valid_names <- c("/",
+                apply(private$h5_info[, 1:2], 1, function(x) {
+                    gsub("//", "/", paste0(x, collapse = "/"))
+            })
+            )
+            assertthat::assert_that(name %in% valid_names)
+            return(rhdf5::h5read(file = private$h5_path, name = name))
+        }
+
+    ),
+    private = list(
+        h5_info = NULL,
+        h5_path = NULL
+    ))
\ No newline at end of file

R/sim_utils.R

@@ -243,22 +243,38 @@ ogs6_read_output_files <- function(ogs6_obj){
 
     assertthat::assert_that(inherits(ogs6_obj, "OGS6"))
 
-    pvd_paths <- list.files(ogs6_obj$sim_path,
-                            "\\.pvd$",
+    output_paths <- list.files(ogs6_obj$sim_path,
+                            "\\.pvd$|\\.h5$",
                             full.names = TRUE)
     # Wait for eventual file writing processes to finish
     t0 <- Sys.time()
-    while(((length(pvd_paths) == 0) | any(file.size(pvd_paths) <= 64)) &
+    while(((length(output_paths) == 0) | any(file.size(output_paths) <= 64)) &
           difftime(Sys.time(), t0, units = "secs") < 2) {
+
+        output_paths <- list.files(ogs6_obj$sim_path,
+                                   "\\.pvd$|\\.h5$",
+                                   full.names = TRUE)
         Sys.sleep(0.01)
     }
-    if (((length(pvd_paths) == 0) | any(file.size(pvd_paths) <= 64)))  {
+    if (((length(output_paths) == 0) | any(file.size(output_paths) <= 64)))  {
         stop("Output file not written out correctly.
                     Unable to import *.pvd")
     } else {
-        ogs6_obj$pvds <- lapply(pvd_paths, function(x){OGS6_pvd$new(pvd_path = x)})
+        pvds_exist <- grepl("\\.pvd$", output_paths)
+        h5s_exist <- grepl("\\.h5$", output_paths)
+        if (any(pvds_exist)) {
+            ogs6_obj$pvds <- lapply(output_paths[which(pvds_exist)],
+                                    function(x) {OGS6_pvd$new(pvd_path = x)})
+    }
+        if (any(h5s_exist)) {
+            ogs6_obj$h5s <- lapply(output_paths[which(h5s_exist)],
+                                   function(x) {OGS6_h5$new(h5_path = x)})
+        }
     }
 
+
+
+
     return(invisible())
 }