Commit 393afd37 authored by phit0's avatar phit0
Browse files

[base] add get_df method for hdf5 output

parent b1363a98
Pipeline #7306 passed with stage
in 2 minutes and 42 seconds
......@@ -13,7 +13,14 @@ OGS6_h5 <- R6::R6Class("OGS6_h5",
assertthat::assert_that(file.exists(h5_path))
private$h5_info <- rhdf5::h5ls(h5_path)
private$h5_path <- h5_path
private$valid_names <-
c("/",
apply(private$h5_info[, 1:2], 1,
function(x) {
gsub("//", "/", paste0(x, collapse = "/"))
}
)
)
},
#' @description Overrides the default print method
print = function(){
......@@ -33,17 +40,74 @@ OGS6_h5 <- R6::R6Class("OGS6_h5",
#' \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)
assertthat::assert_that(name %in% private$valid_names)
return(rhdf5::h5read(file = private$h5_path, name = name))
},
# times and geometry is added as a default
get_df = function(group, names) {
assertthat::is.string(group)
assertthat::assert_that(length(group) == 1)
assertthat::assert_that(is.character(names))
lst <- private$init_lst(group) # adds geometry and time
for (i in seq_along(names)) {
switch(names[i],
"times" = next, # added by default
"geometry" = next, # added by default
# more methods for special variables can be added here
lst[[names[i]]] <- c(
# the c() function stacks all the columns into a vector
self$get_h5(paste0(group, "/", names[i]))
)
)
}
assertthat::assert_that(all(sapply(lst, length) == length(lst[[1]])),
msg = "Whoops O_o some unmatching dimensions.
Please consider using $get_h5()")
return(dplyr::bind_cols(lst))
}
),
private = list(
h5_info = NULL,
h5_path = NULL
h5_path = NULL,
valid_names = NULL,
init_lst = function(group) {
if (paste0(group, "/geometry") %in% private$valid_names) {
geo <- self$get_h5(paste0(group, "/geometry"))
assertthat::assert_that(dim(geo)[3] == 1,
msg = "Can't handle 3d arrays. Please use $get_h5() :)")
geo <- as.matrix(t(geo[, , 1]))
ngeo <- nrow(geo)
} else {
ngeo <- 1 # dont expand time vector
}
if ("/times" %in% private$valid_names) {
tim <- self$get_h5("/times")
ntim <- length(tim)
} else {
}
# expand geometry and time into long format
# stack geo ntim times
geo <- as.matrix(geo) %x% rep(1, ntim) # kroneker product
# same time ngeo times
tim <- rep(tim, each = ngeo)
return(list(
x = geo[, 1],
y = geo[, 2],
z = geo[, 3],
time = tim
))
}
))
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment