ogs6.R

#============================== R6 ================================

#'OGS6
#'@description Constructor for the OGS6 base class
#'@param sim_name The name of the simulation
#'@param sim_id The ID of the simulation
#'@param sim_path The path where all relevant files for the simulation will be saved
#'@param ogs_bin_path Path to OpenGeoSys6 /bin directory
#'@param test_mode In test mode, sim_path and ogs_bin_path will not be validated. If you're not
#' a developer, please leave this variable as it is :)
#'@export
OGS6 <- R6::R6Class("OGS6",
  public = list(

    initialize = function(sim_name,
                          sim_id,
                          sim_path,
                          ogs_bin_path,
                          test_mode = FALSE) {

      # Basic validation
      assertthat::assert_that(assertthat::is.string(sim_name))
      assertthat::assert_that(assertthat::is.number(sim_id))
      assertthat::assert_that(assertthat::is.string(sim_path))
      assertthat::assert_that(assertthat::is.string(ogs_bin_path))

      if(!test_mode){
        validate_paths(sim_path, ogs_bin_path)
      }

        private$.sim_output <- list()

        private$.sim_name <- sim_name
        private$.sim_id <- sim_id
        private$.sim_path <- sim_path
        private$.ogs_bin_path <- ogs_bin_path

        private$.meshes <- list()
        private$.geometry <- NULL
        private$.processes <- list()
        private$.time_loop <- NULL
        private$.media <- list()
        private$.parameters <- list()
        private$.curves <- list()
        private$.process_variables <- list()
        private$.nonlinear_solvers <- list()
        private$.linear_solvers <- list()
        private$.test_definition <- list()
    },

    add_sim_output = function(name, value) {
        private$.sim_output[[name]] <- value
    },

    add_mesh = function(mesh){
      assertthat::assert_that(assertthat::is.string(mesh))
      private$.meshes <- c(private$.meshes, mesh)
    },

    add_gml = function(gml){
      assertthat::assert_that(class(gml) == "r2ogs6_gml")
      if(!is.null(private$.gml)){
        warning("Overwriting gml and geometry variable of OGS6 object", call. = FALSE)

      }
      private$.gml <- gml
      private$.geometry <- paste0(gml$name, ".gml")
    },

    add_process = function(process){
      assertthat::assert_that(class(process) == "r2ogs6_process")
      private$.processes <- c(private$.processes, list(process))
    },

    add_time_loop = function(time_loop){
      assertthat::assert_that(class(time_loop) == "r2ogs6_time_loop")
      if(!is.null(private$.time_loop)){
        warning("Overwriting time_loop variable of OGS6 object", call. = FALSE)

      }
      private$.time_loop <- time_loop
    },

    add_medium = function(medium){
      assertthat::assert_that(class(medium) == "r2ogs6_medium")
      private$.media <- c(private$.media, list(medium))
    },

    add_parameter = function(parameter){
      assertthat::assert_that(class(parameter) == "r2ogs6_parameter")
      private$.parameters <- c(private$.parameters, list(parameter))
    },

    add_curve = function(curve){
      assertthat::assert_that(class(curve) == "r2ogs6_curve")
      private$.curves <- c(private$.curves, list(curve))
    },

    add_process_variable = function(process_variable){
      assertthat::assert_that(class(process_variable) == "r2ogs6_process_variable")
      private$.process_variables <- c(private$.process_variables, list(process_variable))
    },

    add_nonlinear_solver = function(nonlinear_solver){
      assertthat::assert_that(class(nonlinear_solver) == "r2ogs6_nonlinear_solver")
      private$.nonlinear_solvers <- c(private$.nonlinear_solvers, list(nonlinear_solver))
    },

    add_linear_solver = function(linear_solver){
      assertthat::assert_that(class(linear_solver) == "r2ogs6_linear_solver")
      private$.linear_solvers <- c(private$.linear_solvers, list(linear_solver))
    },

    add_vtkdiff = function(vtkdiff){
      assertthat::assert_that(class(vtkdiff) == "r2ogs6_vtkdiff")
      private$.test_definition <- c(private$.test_definition, list(vtkdiff))
    },

    get_status = function(){

      flag <- TRUE

      #.gml
      #flag <- obj_is_defined(flag, private$.gml, "gml")

      #.vtu
      flag <- get_list_status(flag, private$.meshes, "mesh")

      #.prj
      flag <- get_list_status(flag, private$.processes, "process")
      flag <- obj_is_defined(flag, private$.time_loop, "time_loop")
      flag <- get_list_status(flag, private$.media, "medium")
      flag <- get_list_status(flag, private$.parameters, "parameter")
      flag <- get_list_status(flag, private$.curves, "curve", is_opt = TRUE)
      flag <- get_list_status(flag, private$.process_variables, "process_variable")
      flag <- get_list_status(flag, private$.nonlinear_solvers, "nonlinear_solver")
      flag <- get_list_status(flag, private$.linear_solvers, "linear_solver")
      flag <- get_list_status(flag, private$.test_definition, "vtkdiff", is_opt = TRUE)

      if(flag){
        cat(paste0("Your simulation object has all necessary components.\n",
        "You can try to start the simulation by calling run_simulation() on your OGS6 object.\n",
        "Note that this will call more validation functions so you may not be done just yet.\n"))
      }

      return(invisible(flag))
    },

    clear = function(which = c("meshes", "geometry", "processes",
                               "time_loop", "media", "parameters",
                               "curves", "process_variables", "nonlinear_solvers",
                               "linear_solvers", "test_definition")){

      assertthat::assert_that(is.character(which))

      valid_input <- c("meshes", "geometry", "processes",
                       "time_loop", "media", "parameters",
                       "curves", "process_variables", "nonlinear_solvers",
                       "linear_solvers", "test_definition")

      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 = list(
      sim_output = function(value) {
        if (missing(value)) {
          private$.sim_output
        } else {
          stop("To modify `$sim_output`, use set_sim_output().", call. = FALSE)
        }
      },

      sim_name = function(value) {
          if (missing(value)) {
              private$.sim_name
          } else {
              stop("`$sim_name` is read only", call. = FALSE)
          }
      },

      sim_id = function(value) {
          if (missing(value)) {
              private$.sim_id
          } else {
              stop("`$sim_id` is read only", call. = FALSE)
          }
      },

      sim_path = function(value) {
          if (missing(value)) {
              private$.sim_path
          } else {
              stop("`$sim_path` is read only", call. = FALSE)
          }
      },

      ogs_bin_path = function(value) {
        if (missing(value)) {
          private$.ogs_bin_path
        } else {
          stop("`$ogs_bin_path` is read only", call. = FALSE)
        }
      },

      gml = function(value) {
        if (missing(value)) {
          private$.gml
        } else {
          stop("`To modify `$gml`, use add_gml().", call. = FALSE)
        }
      },

      meshes = function(value) {
        if (missing(value)) {
          private$.meshes
        } else {
          stop("`$meshes` is read only", call. = FALSE)
        }
      },

      geometry = function(value) {
        if (missing(value)) {
          private$.geometry
        } else {
          stop("`$geometry` is read only", call. = FALSE)
        }
      },

      processes = function(value) {
        if (missing(value)) {
          private$.processes
        } else {
          stop("`To modify `$processes`, use add_process().", call. = FALSE)
        }
      },

      time_loop = function(value) {
        if (missing(value)) {
          private$.time_loop
        } else {
          stop("`To modify `$time_loop`, use add_time_loop().", call. = FALSE)
        }
      },

      media = function(value) {
        if (missing(value)) {
          private$.media
        } else {
          stop("`To modify `$media`, use add_medium().", call. = FALSE)
        }
      },

      parameters = function(value) {
        if (missing(value)) {
          private$.parameters
        } else {
          stop("`To modify `$parameters`, use add_parameter().", call. = FALSE)
        }
      },

      curves = function(value) {
        if (missing(value)) {
          private$.curves
        } else {
          stop("`To modify `$curves`, use add_curve().", call. = FALSE)
        }
      },

      process_variables = function(value) {
        if (missing(value)) {
          private$.process_variables
        } else {
          stop("`To modify `$process_variables`, use add_process_variable().", call. = FALSE)
        }
      },

      nonlinear_solvers = function(value) {
        if (missing(value)) {
          private$.nonlinear_solvers
        } else {
          stop("`To modify `$nonlinear_solvers`, use add_nonlinear_solver().", call. = FALSE)
        }
      },

      linear_solvers = function(value) {
        if (missing(value)) {
          private$.linear_solvers
        } else {
          stop("`To modify `$linear_solvers`, use add_linear_solver().", call. = FALSE)
        }
      },

      test_definition = function(value) {
        if (missing(value)) {
          private$.test_definition
        } else {
          stop("`To modify `$test_definition`, use add_test_definition().", call. = FALSE)
        }
      }
  ),

  private = list(
    #general parameters
      .sim_output = NULL,
      .sim_name = NULL,
      .sim_id = NULL,
      .sim_path = NULL,
      .ogs_bin_path = NULL,

      #.gml parameters
      .gml = NULL,

      #.prj parameters
      .meshes = NULL,
      .geometry = NULL,
      .processes = NULL,
      .time_loop = NULL,
      .media = NULL,
      .parameters = NULL,
      .curves = NULL,
      .process_variables = NULL,
      .nonlinear_solvers = NULL,
      .linear_solvers = NULL,
      .test_definition = NULL
  )
)