#===== OGS6 ===== #'OGS6 #'@description Constructor for the OGS6 base class #'@export OGS6 <- R6::R6Class("OGS6", public = list( #'@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 #'@param ogs_bin_path string: Path to OpenGeoSys6 /bin directory #'@param test_mode In test mode, ogs_bin_path will not be #' validated. Unless you're a dev, please don't touch. initialize = function(sim_name, sim_id, sim_path, ogs_bin_path, test_mode = FALSE) { # Basic validation assertthat::assert_that(assertthat::is.number(sim_id)) self$sim_name <- sim_name if(missing(sim_path)){ sim_path <- unlist(options("r2ogs6.default_sim_path")) } if(missing(ogs_bin_path)){ ogs_bin_path <- unlist(options("r2ogs6.default_ogs_bin_path")) } if(!test_mode){ if(!file.exists(paste0(ogs_bin_path, "generateStructuredMesh.exe"))) { stop(paste("Could not find executable file", "generateStructuredMesh.exe at location", ogs_bin_path), call. = FALSE) } } private$.sim_id <- sim_id self$sim_path <- sim_path private$.ogs_bin_path <- validate_is_dir_path(ogs_bin_path) }, #===== ADDING COMPONENTS ===== #'@description #'Adds a simulation component (WIP) #'@param x An object of any class listed in addable_components(). If `x` is #' not of a proprietary `r2ogs6` class, `component_name` must be #' supplied. E.g. If you're adding a `python_script` which is a string, you #' would call `your_ogs6_obj$add("some_script.py", "python_script")` #'@param component_name string: Optional: The name of the component to be #' added add = function(x, component_name = ""){ assertthat::assert_that(assertthat::is.string(component_name)) # Assert that class name is in implemented classes for OGS6 ogs6_components <- addable_prj_components() x_class_name <- "" x_of_r2ogs6_class <- FALSE if(any(grepl("r2ogs6", class(x), fixed = TRUE)) || any(grepl("OGS6", class(x), fixed = TRUE))){ x_class_name <- grep("r2ogs6", class(x), value = TRUE) if(length(x_class_name) == 0){ x_class_name <- grep("OGS6", class(x), value = TRUE) } assertthat::assert_that(x_class_name %in% ogs6_components) x_of_r2ogs6_class <- TRUE } # Get name of corresponding OGS6 parameter if(x_of_r2ogs6_class){ component_name <- names(ogs6_components)[ogs6_components == x_class_name] }else{ assertthat::assert_that(component_name %in% names(ogs6_components)) } active_field_call <- ifelse(is_wrapper(component_name), paste0("self$", component_name, " <- c(self$", component_name, ", list(x))"), paste0("self$", component_name, " <- x")) eval(parse(text = active_field_call)) # If class has `name` variable, make it accessable by name if(is_wrapper(component_name) && "name" %in% names(as.list(formals(x_class_name)))){ name_call <- paste0("names(self$", component_name, ")[[length(self$", component_name, ")]] <- x$name") eval(parse(text = name_call)) } }, #'@description #'Adds a reference to a .gml file and optionally, a OGS6_gml object #'@param gml string | r2ogs6_gml: Either a path to a file with extension #' .gml or a r2ogs6_gml object. #@examples add_gml = function(gml){ if(assertthat::is.string(gml)){ assertthat::assert_that(grepl("\\.gml$", gml)) private$.geometry <- gml }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") } }, #'@description #'Adds a reference to a .vtu file and optionally, a OGS6_vtu object #'@param path string: #'@param read_in_vtu flag: Optional: Should .vtu file just be copied or #' read in too? add_vtu = function(path, read_in_vtu = FALSE){ assertthat::assert_that(assertthat::is.string(path)) assertthat::assert_that(grepl("\\.vtu$", path)) assertthat::assert_that(assertthat::is.flag(read_in_vtu)) self$meshes <- c(self$meshes, mesh = path) if(read_in_vtu){ private$.vtus <- c(private$.vtus, list(OGS6_vtu$new(path))) } }, #'@description #'Adds a python script #'@param python_script string: File name of python script add_python_script = function(python_script){ self$python_script <- python_script }, #'@description #'Adds a r2ogs6_search_length_algorithm object #'@param search_length_algorithm r2ogs6_search_length_algorithm add_search_length_algorithm = function(search_length_algorithm){ self$search_length_algorithm <- search_length_algorithm }, #'@description #'Adds a r2ogs6_process object #'@param process r2ogs6_process add_process = function(process){ self$processes <- c(self$processes, list(process)) names(self$processes)[[length(self$processes)]] <- process$name }, #'@description #'Adds a r2ogs6_time_loop object #'@param time_loop r2ogs6_time_loop add_time_loop = function(time_loop){ self$time_loop <- time_loop }, #'@description #'Adds a r2ogs6_local_coordinate_system object #'@param local_coordinate_system r2ogs6_local_coordinate_system add_local_coordinate_system = function(local_coordinate_system){ self$local_coordinate_system <- local_coordinate_system }, #'@description #'Adds a r2ogs6_medium object #'@param medium r2ogs6_medium add_medium = function(medium){ self$media <- c(self$media, list(medium)) }, #'@description #'Adds a r2ogs6_parameter object #'@param parameter r2ogs6_parameter add_parameter = function(parameter){ self$parameters <- c(self$parameters, list(parameter)) names(self$parameters)[[length(self$parameters)]] <- parameter$name }, #'@description #'Adds a r2ogs6_curve object #'@param curve r2ogs6_curve add_curve = function(curve){ self$curves <- c(self$curves, list(curve)) }, #'@description #'Adds a r2ogs6_process_variable object #'@param process_variable r2ogs6_process_variable add_process_variable = function(process_variable){ self$process_variables <- c(self$process_variables, list(process_variable)) names(self$process_variables)[[length(self$process_variables)]] <- process_variable$name }, #'@description #'Adds a r2ogs6_nonlinear_solver object #'@param nonlinear_solver r2ogs6_nonlinear_solver add_nonlinear_solver = function(nonlinear_solver){ self$nonlinear_solvers <- c(self$nonlinear_solvers, list(nonlinear_solver)) names(self$nonlinear_solvers)[[length(self$nonlinear_solvers)]] <- nonlinear_solver$name }, #'@description #'Adds a r2ogs6_linear_solver object #'@param linear_solver r2ogs6_linear_solver add_linear_solver = function(linear_solver){ self$linear_solvers <- c(self$linear_solvers, list(linear_solver)) names(self$linear_solvers)[[length(self$linear_solvers)]] <- linear_solver$name }, #'@description #'Adds a r2ogs6_vtkdiff object #'@param vtkdiff r2ogs6_vtkdiff add_vtkdiff = function(vtkdiff){ self$test_definition <- c(self$test_definition, list(vtkdiff)) }, #'@description #'Adds a r2ogs6_insitu object #'@param insitu r2ogs6_insitu add_insitu = function(insitu){ self$insitu <- insitu }, #===== UTILITY FUNCTIONS ===== #'@description #'Checks if the OGS6 object has all necessary parameters for #' starting a simulation #'@param print_status flag: Should the status be printed to the console? get_status = function(print_status = TRUE){ assertthat::assert_that(assertthat::is.flag(print_status)) flag <- TRUE impl_classes <- addable_prj_components() status_strs <- character() for(i in seq_len(length(impl_classes))){ status_call <- paste0("get_obj_status(flag, private$.", names(impl_classes)[[i]], ")") status <- eval(parse(text = status_call)) flag <- status[[1]] status_strs <- c(status_strs, status[[2]]) } status_str <- paste0(paste(status_strs, collapse = ""), "\n") if(print_status){ cat(status_str) if(flag){ cat(paste0("Your OGS6 object has all necessary components.\n", "You can try calling run_simulation().", "Note that this calls more validation functions, ", "so you may not be done just yet.\n")) } } return(invisible(flag)) }, #'print_log #'@description Prints logfile to console (if it exists) print_log = function(){ if(!is.null(self$logfile)){ writeLines(readLines(self$logfile)) }else{ cat("There is no logfile associated with this OGS6 object.\n") } }, #'@description #'Clears components from the OGS6 object #'@param which character: The names of the components (all by default). #' If you want to delete only some components, run #' names(addable_prj_components()) for the available options. clear = function(which = names(addable_prj_components())){ assertthat::assert_that(is.character(which)) valid_input = names(addable_prj_components()) null_it <- c("geometry", "time_loop") for(i in seq_len(length(which))){ if(!which[[i]] %in% valid_input){ warning(paste0("Parameter '", which[[i]], "' not recognized by OGS6$clear(). ", "Valid parameters are:\n'", paste(valid_input, sep = "", collapse = "', '"), "'\nSkipping."), call. = FALSE) next }else{ call_str <- "" if(which[[i]] %in% null_it){ call_str <- paste0("private$.", which[[i]], " <- NULL") }else{ call_str <- paste0("private$.", which[[i]], " <- list()") } eval(parse(text = call_str)) } } } ), #===== ACTIVE FIELDS ===== active = list( #'@field sim_name #'Access to private parameter '.sim_name' sim_name = function(value) { if(missing(value)) { private$.sim_name }else{ assertthat::assert_that(assertthat::is.string(value)) private$.sim_name <- value } }, #'@field sim_id #'Getter for OGS6 private parameter '.sim_id' sim_id = function() { private$.sim_id }, #'@field sim_path #'Access to private parameter '.sim_path' sim_path = function(value) { if(missing(value)) { private$.sim_path }else{ private$.sim_path <- validate_is_dir_path(value) } }, #'@field logfile #'Access to private parameter '.logfile' logfile = function(value) { if(missing(value)) { private$.logfile }else{ assertthat::assert_that(assertthat::is.string(value)) private$.logfile <- value } }, #'@field ogs_bin_path #'Getter for OGS6 private parameter '.ogs_bin_path' ogs_bin_path = function() { private$.ogs_bin_path }, #'@field gml #'Getter for OGS6 private parameter '.gml' gml = function() { private$.gml }, #'@field geometry #'Access to private parameter '.geometry' geometry = function(value) { if(missing(value)) { private$.geometry }else{ assertthat::assert_that(is.string(value)) private$.geometry <- value } }, #'@field meshes #'Access to private parameter '.meshes' meshes = function(value) { if(missing(value)) { private$.meshes }else{ assertthat::assert_that(is.list(value)) lapply(value, function(x){ assertthat::assert_that(assertthat::is.string(x)) }) private$.meshes <- value } }, #'@field vtus #'Access to private parameter '.vtus' vtus = function(value) { if(missing(value)) { private$.vtus }else{ validate_wrapper_list(value, addable_prj_components()[["vtus"]]) private$.vtus <- value } }, #'@field python_script #'Access to private parameter '.python_script' python_script = function(value) { if(missing(value)) { private$.python_script }else{ assertthat::assert_that(assertthat::is.string(value)) private$.python_script <- value } }, #'@field search_length_algorithm #'Access to private parameter '.search_length_algorithm' search_length_algorithm = function(value) { if(missing(value)) { private$.search_length_algorithm }else{ assertthat::assert_that( addable_prj_components()[["search_length_algorithm"]] %in% class(value)) private$.search_length_algorithm <- value } }, #'@field processes #'Access to private parameter '.processes' processes = function(value) { if(missing(value)) { private$.processes }else{ # If there already is a process element if(length(private$.processes) > 0){ if(addable_prj_components()[["processes"]] %in% class(private$.processes[[1]])){ validate_wrapper_list(value, addable_prj_components()[["processes"]]) }else{ assertthat::assert_that(assertthat::is.string(value)) value <- list(include = c(file = value)) } }else{ if(assertthat::is.string(value)){ value <- list(include = c(file = value)) }else{ validate_wrapper_list(value, addable_prj_components()[["processes"]]) } } private$.processes <- value } }, #'@field time_loop #'Access to private parameter '.time_loop' time_loop = function(value) { if(missing(value)) { private$.time_loop }else{ assertthat::assert_that( addable_prj_components()[["time_loop"]] %in% class(value)) private$.time_loop <- value } }, #'@field local_coordinate_system #'Access to private parameter '.local_coordinate_system' local_coordinate_system = function(value) { if(missing(value)) { private$.local_coordinate_system }else{ assertthat::assert_that( addable_prj_components()[["local_coordinate_system"]] %in% class(value)) private$.local_coordinate_system <- value } }, #'@field media #'Access to private parameter '.media' media = function(value) { if(missing(value)) { private$.media }else{ validate_wrapper_list(value, addable_prj_components()[["media"]]) private$.media <- value } }, #'@field parameters #'Access to private parameter '.parameters' parameters = function(value) { if(missing(value)) { private$.parameters }else{ validate_wrapper_list(value, addable_prj_components()[["parameters"]]) private$.parameters <- value } }, #'@field curves #'Access to private parameter '.curves' curves = function(value) { if(missing(value)) { private$.curves }else{ validate_wrapper_list(value, addable_prj_components()[["curves"]]) private$.curves <- value } }, #'@field process_variables #'Access to private parameter '.process_variables' process_variables = function(value) { if(missing(value)) { private$.process_variables }else{ validate_wrapper_list( value, addable_prj_components()[["process_variables"]]) private$.process_variables <- value } }, #'@field nonlinear_solvers #'Access to private parameter '.nonlinear_solvers' nonlinear_solvers = function(value) { if(missing(value)) { private$.nonlinear_solvers }else{ validate_wrapper_list( value, addable_prj_components()[["nonlinear_solvers"]]) private$.nonlinear_solvers <- value } }, #'@field linear_solvers #'Access to private parameter '.linear_solvers' linear_solvers = function(value) { if(missing(value)) { private$.linear_solvers }else{ validate_wrapper_list(value, addable_prj_components()[["linear_solvers"]]) private$.linear_solvers <- value } }, #'@field test_definition #'Access to private parameter '.test_definition' test_definition = function(value) { if(missing(value)) { private$.test_definition }else{ validate_wrapper_list(value, addable_prj_components()[["test_definition"]]) private$.test_definition <- value } }, #'@field insitu #'Access to private parameter '.insitu' insitu = function(value) { if(missing(value)) { private$.insitu }else{ assertthat::assert_that( addable_prj_components()[["insitu"]] %in% class(value)) private$.insitu <- value } }, #'@field pvd #'Access to private parameter '.pvd' pvd = function(value) { if(missing(value)) { private$.pvd }else{ assertthat::assert_that(inherits(value, "OGS6_pvd")) private$.pvd <- value } } ), private = list( # general parameters .sim_name = NULL, .sim_id = NULL, .sim_path = NULL, .ogs_bin_path = NULL, .logfile = NULL, # .gml object .gml = NULL, # .vtu objects .vtus = NULL, # .prj parameters # .gml reference .geometry = NULL, # .vtu reference(s) .meshes = list(), .python_script = NULL, .search_length_algorithm = NULL, .processes = list(), .time_loop = NULL, .local_coordinate_system = NULL, .media = list(), .parameters = list(), .curves = list(), .process_variables = list(), .nonlinear_solvers = list(), .linear_solvers = list(), .test_definition = list(), .insitu = NULL, # .pvd object (output) .pvd = NULL ) )