From 9058c5a42282f9d06dd8a3cb5991b01392076ffb Mon Sep 17 00:00:00 2001
From: aheinri5 <Anna@netzkritzler.de>
Date: Mon, 8 Feb 2021 00:13:14 +0100
Subject: [PATCH] [feature] #15 added print method to R6 classes
---
R/ogs6.R | 57 +++++++++++++++++++++++----------
R/ogs6_ensemble.R | 42 +++++++++++++++++++++----
R/ogs6_gml.R | 19 +++++++++++
R/ogs6_pvd.R | 67 +++++++++++++++++++++++++--------------
R/ogs6_vtu.R | 80 ++++++++++++++++++++++++++++++-----------------
5 files changed, 192 insertions(+), 73 deletions(-)
diff --git a/R/ogs6.R b/R/ogs6.R
index fe3bd68..40f9206 100644
--- a/R/ogs6.R
+++ b/R/ogs6.R
@@ -11,19 +11,14 @@ OGS6 <- R6::R6Class("OGS6",
#'@description
#'Creates new OGS6 object
#'@param sim_name string: Simulation name
- #'@param sim_id double: Simulation ID
#'@param sim_path string: Path where all files for the simulation will be
#' saved
initialize = function(sim_name,
- sim_id,
sim_path) {
# Basic validation
self$sim_name <- sim_name
- assertthat::assert_that(assertthat::is.number(sim_id))
- private$.sim_id <- sim_id
-
if(missing(sim_path)){
sim_path <- unlist(options("r2ogs6.default_sim_path"))
}
@@ -67,6 +62,8 @@ OGS6 <- R6::R6Class("OGS6",
eval(parse(text = name_call))
}
+
+ invisible(self)
},
#'@description
@@ -82,13 +79,10 @@ OGS6 <- R6::R6Class("OGS6",
}else{
assertthat::assert_that(inherits(gml, "OGS6_gml"))
private$.gml <- gml
-
- if(!is.null(private$.geometry)){
- warning(paste("OGS6 parameter 'geometry' now refers",
- "to a different .gml object"), call. = FALSE)
- }
private$.geometry <- paste0(self$sim_name, ".gml")
}
+
+ invisible(self)
},
#'@description
@@ -107,6 +101,8 @@ OGS6 <- R6::R6Class("OGS6",
if(read_in_vtu){
private$.vtus <- c(private$.vtus, list(OGS6_vtu$new(path)))
}
+
+ invisible(self)
},
@@ -170,6 +166,37 @@ OGS6 <- R6::R6Class("OGS6",
return(invisible(flag))
},
+ #'@description
+ #'Overrides default printing behaviour
+ print = function(){
+ cat("OGS6\n")
+ cat("simulation name: ", self$sim_name, "\n", sep = "")
+ cat("simulation path: ", self$sim_path, "\n", sep = "")
+
+ cat("\n----- geometry: ", self$geometry, "\n", sep = "")
+ cat("associated OGS6_gml:\n")
+ print(self$gml)
+
+ cat("\n----- meshes -----\n",
+ paste(self$meshes, collapse = "\n"),
+ "\n", sep = "")
+
+ prj_tags <- lapply(prj_top_level_tags(), function(x){x[["tag_name"]]})
+ prj_tags <- prj_tags[!prj_tags %in% c("geometry", "mesh", "meshes")]
+
+ for(i in seq_len(length(prj_tags))){
+ tag_name <- prj_tags[[i]]
+
+ prj_param_call <- paste0("print(self$", tag_name, ")")
+
+ cat("\n----- ", tag_name, " -----\n", sep = "")
+ eval(parse(text = prj_param_call))
+ cat("\n", sep = "")
+ }
+
+ invisible(self)
+ },
+
#'print_log
#'@description Prints logfile to console (if it exists)
print_log = function(){
@@ -178,6 +205,8 @@ OGS6 <- R6::R6Class("OGS6",
}else{
cat("There is no logfile associated with this OGS6 object.\n")
}
+
+ invisible(self)
},
#'@description
@@ -213,6 +242,8 @@ OGS6 <- R6::R6Class("OGS6",
eval(parse(text = call_str))
}
}
+
+ invisible(self)
}
),
@@ -234,12 +265,6 @@ OGS6 <- R6::R6Class("OGS6",
}
},
- #'@field sim_id
- #'Simulation ID. read-only
- sim_id = function() {
- private$.sim_id
- },
-
#'@field sim_path
#'Simulation path. `value` must be string
sim_path = function(value) {
diff --git a/R/ogs6_ensemble.R b/R/ogs6_ensemble.R
index 3eac072..d87c3fa 100644
--- a/R/ogs6_ensemble.R
+++ b/R/ogs6_ensemble.R
@@ -72,12 +72,32 @@ OGS6_Ensemble <- R6::R6Class(
},
#'@description
- #'Runs the simulation. This calls r2ogs6::ogs_run_simulation() internally.
- #' For ensembles, output will be written to logfiles.
+ #'Overrides default printing behaviour
+ print = function(){
+ cat("OGS6_Ensemble\n")
+ cat("ensemble size: ", length(self$ensemble), "\n", sep = "")
+ cat("sequential_mode: ",
+ !is.null(private$.ranges),
+ "\n", sep = "")
+ cat("percentages_mode: ",
+ !is.null(self$parameter_percs),
+ "\n", sep = "")
+ cat("\nmodified parameters:\n",
+ paste(self$dp_parameters, collapse = "\n"),
+ "\n", sep = "")
+ cat("\nparameter values:\n")
+ print(self$parameter_values)
+
+ invisible(self)
+ },
+
+ #'@description
+ #'Runs the simulation. This calls r2ogs6::ogs_run_simulation()
+ #' internally. For ensembles, output will always be written to logfiles.
#'@param parallel flag: Should the function be run in parallel?
#' This is implementented via the 'parallel' package.
#'@param verbose flag
- ogs_run_simulation = function(parallel = FALSE,
+ run_simulation = function(parallel = FALSE,
verbose = F){
assertthat::assert_that(assertthat::is.flag(parallel))
@@ -144,8 +164,17 @@ OGS6_Ensemble <- R6::R6Class(
}
},
+ #'@description
+ #'If the ensemble was created in sequential_mode, this will get the
+ #' name of the value vector that was being iterated over at the given
+ #' `index` during ensemble creation. I. e. if the ensemble was created
+ #' with the value vectors `a = c(1, 2, 3)` and `b = c("foo", "bar")`,
+ #' an `index` of 4 would return `"b"`
+ #'@param index number: Index
relevant_parameter_at = function(index){
+ assertthat::assert_that(assertthat::is.number(index))
+
if(is.null(private$.ranges)){
warning(paste("This ensemble wasn't set up in sequential mode",
call. = FALSE))
@@ -206,9 +235,10 @@ OGS6_Ensemble <- R6::R6Class(
for(i in seq_len(length(private$.parameter_percs))){
val <- eval(parse(text = self$dp_parameters[[i]]))
- val_vec <- lapply(private$.parameter_percs[[i]], function(x){
+ val_vec <- vapply(private$.parameter_percs[[i]], function(x){
val + (val * (x / 100))
- })
+ },
+ FUN.VALUE = numeric(length(val)))
private$.parameter_values <- c(self$parameter_values,
list(val_vec))
@@ -310,7 +340,7 @@ OGS6_Ensemble <- R6::R6Class(
.ens_path = NULL,
.ensemble = list(),
.dp_parameters = list(),
- .parameter_percs = list(),
+ .parameter_percs = NULL,
.parameter_values = list()
)
)
diff --git a/R/ogs6_gml.R b/R/ogs6_gml.R
index 732c4a2..6d6ce74 100644
--- a/R/ogs6_gml.R
+++ b/R/ogs6_gml.R
@@ -49,6 +49,25 @@ OGS6_gml <- R6::R6Class(
private$.gml_path <- gml_path
private$validate()
+ },
+
+ #'@description
+ #'Overrides default printing behaviour
+ print = function(){
+ cat("OGS6_gml\n")
+ cat("path: ", self$gml_path, "\n", sep = "")
+ cat("name: ", self$name, "\n", sep = "")
+
+ cat("\npoints\n")
+ print(self$points)
+
+ cat("\npolylines\n")
+ print(self$polylines)
+
+ cat("\nsurfaces\n")
+ print(self$surfaces)
+
+ return(invisible(self))
}
),
diff --git a/R/ogs6_pvd.R b/R/ogs6_pvd.R
index a42ebba..a3e717f 100644
--- a/R/ogs6_pvd.R
+++ b/R/ogs6_pvd.R
@@ -26,6 +26,27 @@ OGS6_pvd <- R6::R6Class(
},
+ #'@description
+ #'Overrides default printing behaviour
+ print = function(){
+ cat("OGS6_pvd\n")
+ cat("number of referenced .vtu paths (= number of timesteps): ",
+ length(self$abs_vtu_paths),
+ "\n", sep = "")
+ cat("\n.vtu paths (absolute):\n",
+ paste(self$abs_vtu_paths, collapse = "\n"),
+ "\n", sep = "")
+
+ cat("\ntimesteps:\n",
+ paste(self$timesteps, collapse = "\n"),
+ "\n", sep = "")
+
+ cat("\nfirst OGS6_vtu in OGS6_vtus:\n")
+ print(self$OGS6_vtus[[1]])
+
+ invisible(self)
+ },
+
#'@description
#'Returns .vtu path for specified timestep
#'@param timestep string: Timestep
@@ -64,24 +85,24 @@ OGS6_pvd <- R6::R6Class(
#'Returns a tibble containing point data
#'@param coordinates list(numeric): List of coordinates (a coordinate
#' is a numeric vector of length 3)
- #'@param Names character: Optional: `Name` attributes of `DataArray`
+ #'@param keys character: Optional: `Name` attributes of `DataArray`
#' elements. Defaults to all.
#'@param start_at_timestep number: Optional: Timestep to start at.
#' Defaults to first timestep.
#'@param end_at_timestep number: Optional: Timestep to end at. Defaults
#' to last timestep.
get_point_data_at = function(coordinates,
- Names,
+ keys,
start_at_timestep,
end_at_timestep){
coordinates <- validate_coordinates(coordinates)
- if(missing(Names)){
- Names <- as.character(self$point_data$keys())
+ if(missing(keys)){
+ keys <- as.character(self$point_data$keys())
}
- assertthat::assert_that(is.character(Names))
+ assertthat::assert_that(is.character(keys))
# Use point locator to get data
point_ids <- lapply(coordinates, function(x){
@@ -89,7 +110,7 @@ OGS6_pvd <- R6::R6Class(
})
return(self$get_point_data(point_ids = as.numeric(point_ids),
- Names = Names,
+ keys = keys,
start_at_timestep = start_at_timestep,
end_at_timestep = end_at_timestep))
},
@@ -97,14 +118,14 @@ OGS6_pvd <- R6::R6Class(
#'@description
#'Returns a tibble containing point data
#'@param point_ids numeric: Optional: Point IDs. Defaults to all.
- #'@param Names character: Optional: `Name` attributes of `DataArray`
+ #'@param keys character: Optional: `Name` attributes of `DataArray`
#' elements. Defaults to all.
#'@param start_at_timestep number: Optional: Timestep to start at.
#' Defaults to first timestep.
#'@param end_at_timestep number: Optional: Timestep to end at. Defaults
#' to last timestep.
get_point_data = function(point_ids,
- Names,
+ keys,
start_at_timestep,
end_at_timestep){
@@ -113,14 +134,14 @@ OGS6_pvd <- R6::R6Class(
point_ids <- seq(0, max_id)
}
- if(missing(Names)){
- Names <- as.character(self$OGS6_vtus[[1]]$point_data$keys())
+ if(missing(keys)){
+ keys <- as.character(self$OGS6_vtus[[1]]$point_data$keys())
}
private$get_data(
data_type = "points",
ids = point_ids,
- Names = Names,
+ keys = keys,
start_at_timestep = start_at_timestep,
end_at_timestep = end_at_timestep
)
@@ -129,14 +150,14 @@ OGS6_pvd <- R6::R6Class(
#'@description
#'Returns a tibble containing cell data
#'@param cell_ids numeric: Optional: Cell IDs. Defaults to all.
- #'@param Names character: Optional: `Name` attributes of `DataArray`
+ #'@param keys character: Optional: `Name` attributes of `DataArray`
#' elements. Defaults to all.
#'@param start_at_timestep number: Optional: Timestep to start at.
#' Defaults to first timestep.
#'@param end_at_timestep number: Optional: Timestep to end at. Defaults
#' to last timestep.
get_cell_data = function(cell_ids,
- Names,
+ keys,
start_at_timestep,
end_at_timestep){
@@ -145,14 +166,14 @@ OGS6_pvd <- R6::R6Class(
cell_ids <- seq(0, max_id)
}
- if(missing(Names)){
- Names <- as.character(self$OGS6_vtus[[1]]$cell_data$keys())
+ if(missing(keys)){
+ keys <- as.character(self$OGS6_vtus[[1]]$cell_data$keys())
}
private$get_data(
data_type = "cells",
ids = cell_ids,
- Names = Names,
+ keys = keys,
start_at_timestep = start_at_timestep,
end_at_timestep = end_at_timestep
)
@@ -240,12 +261,12 @@ OGS6_pvd <- R6::R6Class(
#Returns a dataframe with all of the CellData
get_data = function(data_type,
ids,
- Names,
+ keys,
start_at_timestep,
end_at_timestep){
assertthat::assert_that(is.numeric(ids))
- assertthat::assert_that(is.character(Names))
+ assertthat::assert_that(is.character(keys))
if(missing(start_at_timestep)){
start_at_timestep <- self$timesteps[[1]]
@@ -280,21 +301,21 @@ OGS6_pvd <- R6::R6Class(
values <- list()
- for(j in seq_len(length(Names))){
+ for(j in seq_len(length(keys))){
rid <- ids[[i]] + 1
if(length(
- dim(data[[Names[[j]]]])) == 1){
- value <- data[[Names[[j]]]][[rid]]
+ dim(data[[keys[[j]]]])) == 1){
+ value <- data[[keys[[j]]]][[rid]]
}else{
value <- list(as.numeric(
- data[[Names[[j]]]][rid,]))
+ data[[keys[[j]]]][rid,]))
}
values <- c(values, list(value))
- names(values)[[length(values)]] <- Names[[j]]
+ names(values)[[length(values)]] <- keys[[j]]
}
new_row <- c(new_row, values)
diff --git a/R/ogs6_vtu.R b/R/ogs6_vtu.R
index 12ce427..4f8736f 100644
--- a/R/ogs6_vtu.R
+++ b/R/ogs6_vtu.R
@@ -27,19 +27,43 @@ OGS6_vtu <- R6::R6Class(
private$.vtu_path <- vtu_path
},
+ #'@description
+ #'Overrides default printing behaviour
+ print = function(){
+ cat("OGS6_vtu\n")
+ cat("path: ", self$vtu_path, "\n", sep = "")
+
+ cat("\nfield data keys:\n",
+ paste(self$field_data$keys(), collapse = ("\n")),
+ "\n", sep = "")
+
+ cat("\nnumber of points: ", self$number_of_points, "\n", sep = "")
+ cat("\npoint data keys:\n",
+ paste(self$point_data$keys(), collapse = ("\n")),
+ "\n", sep = "")
+
+ cat("\nnumber of cells: ", self$number_of_cells, "\n", sep = "")
+ cat("\ncell data keys:\n",
+ paste(self$cell_data$keys(), collapse = ("\n")),
+ "\n", sep = "")
+
+ invisible(self)
+ },
+
+
#'@description
#'Gets FieldData.
- #'@param Names character: Optional: `Name` attributes of `DataArray`
+ #'@param keys character: Optional: `Name` attributes of `DataArray`
#' elements, defaults to all in `FieldData`
#'@return list: List of format list(value_a = 1, value_b = 2), where the
#' names reference the `Name` attributes of the `DataArray` elements
- get_field_data = function(Names){
+ get_field_data = function(keys){
- if(missing(Names)){
- Names <- as.character(self$field_data$keys())
+ if(missing(keys)){
+ keys <- as.character(self$field_data$keys())
}
- field_data <- lapply(Names, function(x){
+ field_data <- lapply(keys, function(x){
self$field_data[[x]]
})
@@ -69,18 +93,18 @@ OGS6_vtu <- R6::R6Class(
#'Gets PointData at specified coordinates.
#'@param coordinates list(numeric): List of coordinates (a coordinate
#' is a numeric vector of length 3)
- #'@param Names character: Optional: `Name` attributes of `DataArray`
+ #'@param keys character: Optional: `Name` attributes of `DataArray`
#' elements, defaults to all in `PointData`
get_point_data_at = function(coordinates,
- Names){
+ keys){
coordinates <- validate_coordinates(coordinates)
- if(missing(Names)){
- Names <- as.character(self$point_data$keys())
+ if(missing(keys)){
+ keys <- as.character(self$point_data$keys())
}
- assertthat::assert_that(is.character(Names))
+ assertthat::assert_that(is.character(keys))
# Use point locator to get data
point_ids <- lapply(coordinates, function(x){
@@ -88,54 +112,54 @@ OGS6_vtu <- R6::R6Class(
})
return(self$get_point_data(point_ids = as.numeric(point_ids),
- Names = Names))
+ keys = keys))
},
#'@description
#'Gets PointData for points with IDs in `point_ids`.
#'@param point_ids numeric: Optional: Point IDs, defaults to all
- #'@param Names character: Optional: `Name` attributes of `DataArray`
+ #'@param keys character: Optional: `Name` attributes of `DataArray`
#' elements, defaults to all in `PointData`
#'@return tibble: Tibble where each row represents a point.
get_point_data = function(point_ids,
- Names){
+ keys){
if(missing(point_ids)){
max_point_id <- self$number_of_points() - 1
point_ids <- seq(0, max_point_id)
}
- if(missing(Names)){
- Names <- as.character(self$point_data$keys())
+ if(missing(keys)){
+ keys <- as.character(self$point_data$keys())
}
private$get_data(data_type = "points",
ids = point_ids,
- Names = Names)
+ keys = keys)
},
#'@description
#'Gets CellData for cells with IDs in `cell_ids`.
#'@param cell_ids numeric: Optional: Cell IDs, defaults to all
- #'@param Names character: Optional: `Name` attributes of `DataArray`
+ #'@param keys character: Optional: `Name` attributes of `DataArray`
#' elements, defaults to all in `CellData`
#'@return tibble: Tibble where each row represents a cell.
get_cell_data = function(cell_ids,
- Names){
+ keys){
if(missing(cell_ids)){
max_cell_id <- self$number_of_cells() - 1
cell_ids <- seq(0, max_cell_id)
}
- if(missing(Names)){
- Names <- as.character(self$cell_data$keys())
+ if(missing(keys)){
+ keys <- as.character(self$cell_data$keys())
}
private$get_data(data_type = "cells",
ids = cell_ids,
- Names = Names)
+ keys = keys)
}
),
@@ -220,10 +244,10 @@ OGS6_vtu <- R6::R6Class(
get_data = function(data_type,
ids,
- Names){
+ keys){
assertthat::assert_that(is.numeric(ids))
- assertthat::assert_that(is.character(Names))
+ assertthat::assert_that(is.character(keys))
tbl_rows <- list()
@@ -245,19 +269,19 @@ OGS6_vtu <- R6::R6Class(
values <- list()
- for (j in seq_len(length(Names))) {
+ for (j in seq_len(length(keys))) {
rid <- ids[[i]] + 1
- if (length(dim(data[[Names[[j]]]])) == 1) {
- value <- data[[Names[[j]]]][[rid]]
+ if (length(dim(data[[keys[[j]]]])) == 1) {
+ value <- data[[keys[[j]]]][[rid]]
} else{
- value <- list(as.numeric(data[[Names[[j]]]][rid,]))
+ value <- list(as.numeric(data[[keys[[j]]]][rid,]))
}
values <- c(values, list(value))
names(values)[[length(values)]] <-
- Names[[j]]
+ keys[[j]]
}
new_row <- c(new_row,
--
GitLab