Skip to content
Snippets Groups Projects
Commit 9058c5a4 authored by Ruben Heinrich's avatar Ruben Heinrich
Browse files

[feature] #15 added print method to R6 classes

parent aa189878
No related branches found
No related tags found
1 merge request!10Resolve "user-friendly print method for `OGS6` class and associated classes needed"
Hide whitespace changes
Inline Side-by-side
R/ogs6.R
+ 41
− 16
View file @ 9058c5a4
......@@ -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) {
......
R/ogs6_ensemble.R
+ 36
− 6
View file @ 9058c5a4
......@@ -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()
)
)
......
R/ogs6_gml.R
+ 19
− 0
View file @ 9058c5a4
......@@ -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))
}
),
......
R/ogs6_pvd.R
+ 44
− 23
View file @ 9058c5a4
......@@ -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)
......
R/ogs6_vtu.R
+ 52
− 28
View file @ 9058c5a4
......@@ -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,
......
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