#===== prj_time_loop ===== #' prj_time_loop #' @description tag: time_loop #' @param processes list, prj_tl_process: #' @param output prj_output: #' @param global_process_coupling Optional: prj_global_process_coupling: #' @example man/examples/ex_prj_time_loop.R #' @export prj_time_loop <- function(processes, output, global_process_coupling = NULL) { #Make this more user friendly #... new_prj_time_loop(processes, output, global_process_coupling) } new_prj_time_loop <- function(processes, output, global_process_coupling = NULL) { is_wrapper_list(processes, "prj_tl_process") assertthat::assert_that(class(output) == "prj_output") is_null_or_has_class(global_process_coupling, "prj_global_process_coupling") structure( list( processes = processes, output = output, global_process_coupling = global_process_coupling, xpath = "time_loop", attr_names = character(), flatten_on_exp = character() ), class = "prj_time_loop" ) } #===== prj_tl_process ===== #' prj_tl_process #' @description tag: process (parent: time_loop, NOT processes!) #' @param ref string: References a prj_process object by name #' @param nonlinear_solver string: #' @param convergence_criterion prj_convergence_criterion: #' @param time_discretization vector: #' @param time_stepping prj_time_stepping: #' @param compensate_non_equilibrium_initial_residuum string: Optional: Either #' "true" or "false" #' @example man/examples/ex_prj_tl_process.R #' @export prj_tl_process <- function(ref, nonlinear_solver, convergence_criterion, time_discretization, time_stepping, compensate_non_equilibrium_initial_residuum = NULL) { #Make this more user friendly #... new_prj_tl_process( ref, nonlinear_solver, convergence_criterion, time_discretization, time_stepping, compensate_non_equilibrium_initial_residuum ) } new_prj_tl_process <- function(ref, nonlinear_solver, convergence_criterion, time_discretization, time_stepping, compensate_non_equilibrium_initial_residuum = NULL) { assertthat::assert_that(assertthat::is.string(ref)) assertthat::assert_that(assertthat::is.string(nonlinear_solver)) assertthat::assert_that(class(convergence_criterion) == "prj_convergence_criterion") assertthat::assert_that(is.vector(time_discretization)) assertthat::assert_that(class(time_stepping) == "prj_time_stepping") if(!is.null(compensate_non_equilibrium_initial_residuum)){ compensate_non_equilibrium_initial_residuum <- stringr::str_remove_all(compensate_non_equilibrium_initial_residuum, "[:space:]*") } are_null_or_string_flags(compensate_non_equilibrium_initial_residuum) structure( list(ref = ref, nonlinear_solver = nonlinear_solver, convergence_criterion = convergence_criterion, time_discretization = time_discretization, time_stepping = time_stepping, compensate_non_equilibrium_initial_residuum = compensate_non_equilibrium_initial_residuum, xpath = "time_loop/processes/process", attr_names = c("ref"), flatten_on_exp = character() ), class = "prj_tl_process" ) } #===== prj_output ===== #' prj_output #' @description tag: output #' @param type string: #' @param prefix string: #' @param variables vector: #' @param suffix Optional: string: #' @param timesteps Optional: #' @param compress_output Optional: string: Should the output be compressed? #' Either "true" or "false" #' @param data_mode Optional: string: #' @param output_iteration_results Optional: string: Either "true" or "false" #' @param meshes Optional: character: A vector of mesh names #' @param fixed_output_times Optional: string | numeric: #' @param hdf Optional: numeric #' @example man/examples/ex_prj_output.R #' @export prj_output <- function(type, prefix, variables, suffix = NULL, timesteps = NULL, compress_output = NULL, data_mode = NULL, output_iteration_results = NULL, meshes = NULL, fixed_output_times = NULL, hdf = NULL) { #Coerce input fixed_output_times <- coerce_string_to_numeric(fixed_output_times) if(is.list(meshes)){ meshes <- unlist(meshes) } new_prj_output(type, prefix, variables, suffix, timesteps, compress_output, data_mode, output_iteration_results, meshes, fixed_output_times, hdf) } new_prj_output <- function(type, prefix, variables, suffix = NULL, timesteps = NULL, compress_output = NULL, data_mode = NULL, output_iteration_results = NULL, meshes = NULL, fixed_output_times = NULL, hdf = NULL) { assertthat::assert_that(assertthat::is.string(type)) assertthat::assert_that(assertthat::is.string(prefix)) assertthat::assert_that(is.vector(variables)) names(variables) <- rep("variable", length(variables)) are_null_or_strings(suffix, data_mode) if(!is.null(timesteps)){ timesteps <- validate_timesteps(timesteps, TRUE) } are_null_or_string_flags(compress_output) if(!is.null(meshes)){ assertthat::assert_that(is.character(meshes)) names(meshes) <- rep("mesh", length(meshes)) } are_null_or_numeric(fixed_output_times) structure( list(type = type, prefix = prefix, variables = variables, suffix = suffix, timesteps = timesteps, compress_output = compress_output, data_mode = data_mode, output_iteration_results = output_iteration_results, meshes = meshes, fixed_output_times = fixed_output_times, hdf = hdf, xpath = "time_loop/output", attr_names = character(), flatten_on_exp = c("fixed_output_times") ), class = "prj_output" ) } #===== prj_global_process_coupling ===== #' prj_global_process_coupling #' @description tag: global_process_coupling #' @param max_iter string | double: Maximal number of iterations #' @param convergence_criteria list, prj_convergence_criterion: #' Convergence criteria #' @example man/examples/ex_prj_global_process_coupling.R #' @export prj_global_process_coupling <- function(max_iter, convergence_criteria) { #Coerce input max_iter <- coerce_string_to_numeric(max_iter) new_prj_global_process_coupling(max_iter, convergence_criteria) } new_prj_global_process_coupling <- function(max_iter, convergence_criteria) { assertthat::assert_that(is.double(max_iter)) is_wrapper_list(convergence_criteria, "prj_convergence_criterion") structure( list( max_iter = max_iter, convergence_criteria = convergence_criteria, xpath = "time_loop/global_process_coupling", attr_names = character(), flatten_on_exp = character() ), class = "prj_global_process_coupling" ) } #===== prj_convergence_criterion ===== #' prj_convergence_criterion #' @description tag: convergence_criterion #' @param type string: Type #' @param norm_type string: ... #' @param abstol string | double: Absolute tolerance #' @param reltol string | double: Relative tolerance #' @param abstols string | numeric: Absolute tolerances #' @param reltols string | numeric: Relative tolerances #' @example man/examples/ex_prj_convergence_criterion.R #' @export prj_convergence_criterion <- function(type, norm_type, abstol = NULL, reltol = NULL, abstols = NULL, reltols = NULL) { #Coerce input abstol <- coerce_string_to_numeric(abstol) reltol <- coerce_string_to_numeric(reltol) abstols <- coerce_string_to_numeric(abstols) reltols <- coerce_string_to_numeric(reltols) new_prj_convergence_criterion(type, norm_type, abstol, reltol, abstols, reltols) } new_prj_convergence_criterion <- function(type, norm_type, abstol = NULL, reltol = NULL, abstols = NULL, reltols = NULL) { assertthat::assert_that(assertthat::is.string(type)) assertthat::assert_that(assertthat::is.string(norm_type)) are_null_or_numbers(abstol, reltol) are_null_or_numeric(abstols, reltols) structure( list( type = type, norm_type = norm_type, abstol = abstol, reltol = reltol, abstols = abstols, reltols = reltols, xpath = c("time_loop/processes/process/convergence_criterion", paste0("time_loop/global_process_coupling/", "convergence_criteria/convergence_criterion")), attr_names = character(), flatten_on_exp = c("abstols", "reltols") ), class = "prj_convergence_criterion" ) } #===== prj_time_stepping ===== #' prj_time_stepping #' @description tag: time_stepping #' @param type string: #' @param t_initial Optional: string | double: #' @param t_end Optional: string | double: #' @param timesteps Optional: list: #' @param initial_dt Optional: string | double: #' @param minimum_dt Optional: string | double: #' @param maximum_dt Optional: string | double: #' @param number_iterations Optional: string | numeric: #' @param multiplier Optional: string | numeric: #' @param dt_guess Optional: string | double: #' @param dt_min Optional: string | double: #' @param dt_max Optional: string | double: #' @param rel_dt_min Optional: string | double: #' @param rel_dt_max Optional: string | double: #' @param tol Optional: string | double: #' @example man/examples/ex_prj_time_stepping.R #' @export prj_time_stepping <- function(type, t_initial = NULL, t_end = NULL, timesteps = NULL, initial_dt = NULL, minimum_dt = NULL, maximum_dt = NULL, number_iterations = NULL, multiplier = NULL, dt_guess = NULL, dt_min = NULL, dt_max = NULL, rel_dt_min = NULL, rel_dt_max = NULL, tol = NULL) { # Coerce input t_initial <- coerce_string_to_numeric(t_initial) t_end <- coerce_string_to_numeric(t_end) initial_dt <- coerce_string_to_numeric(initial_dt) minimum_dt <- coerce_string_to_numeric(minimum_dt) maximum_dt <- coerce_string_to_numeric(maximum_dt) dt_guess <- coerce_string_to_numeric(dt_guess) dt_min <- coerce_string_to_numeric(dt_min) dt_max <- coerce_string_to_numeric(dt_max) rel_dt_min <- coerce_string_to_numeric(rel_dt_min) rel_dt_max <- coerce_string_to_numeric(rel_dt_max) tol <- coerce_string_to_numeric(tol) number_iterations <- coerce_string_to_numeric(number_iterations) multiplier <- coerce_string_to_numeric(multiplier) new_prj_time_stepping(type, t_initial, t_end, timesteps, initial_dt, minimum_dt, maximum_dt, number_iterations, multiplier, dt_guess, dt_min, dt_max, rel_dt_min, rel_dt_max, tol) } new_prj_time_stepping <- function(type, t_initial = NULL, t_end = NULL, timesteps = NULL, initial_dt = NULL, minimum_dt = NULL, maximum_dt = NULL, number_iterations = NULL, multiplier = NULL, dt_guess = NULL, dt_min = NULL, dt_max = NULL, rel_dt_min = NULL, rel_dt_max = NULL, tol = NULL) { are_strings(type) are_null_or_numbers(t_initial, t_end, initial_dt, minimum_dt, maximum_dt, dt_guess, dt_min, dt_max, rel_dt_min, rel_dt_max, tol) are_null_or_numeric(number_iterations, multiplier) if(!is.null(timesteps)){ timesteps <- validate_timesteps(timesteps) } structure(list(type = type, t_initial = t_initial, t_end = t_end, timesteps = timesteps, initial_dt = initial_dt, minimum_dt = minimum_dt, maximum_dt = maximum_dt, number_iterations = number_iterations, multiplier = multiplier, dt_guess = dt_guess, dt_min = dt_min, dt_max = dt_max, rel_dt_min = rel_dt_min, rel_dt_max = rel_dt_max, tol = tol, xpath = "time_loop/processes/process/time_stepping", attr_names = character(), flatten_on_exp = c("number_iterations", "multiplier") ), class = "prj_time_stepping" ) } #===== timesteps validation ===== #Validation helper function validate_timesteps <- function(timesteps, in_output = FALSE){ assertthat::assert_that(is.list(timesteps)) for(i in seq_len(length(timesteps))){ assertthat::assert_that(is.vector(timesteps[[i]])) assertthat::assert_that(length(timesteps[[i]]) == 2) names(timesteps[[i]])[[1]] <- "repeat" #Coerce input if(assertthat::is.string(timesteps[[i]][[1]])){ timesteps[[i]][[1]] <- as.double(timesteps[[i]][[1]]) } if(assertthat::is.string(timesteps[[i]][[2]])){ timesteps[[i]][[2]] <- as.double(timesteps[[i]][[2]]) } if(!in_output){ names(timesteps[[i]])[[2]] <- "delta_t" }else{ names(timesteps[[i]])[[2]] <- "each_steps" } } names(timesteps) <- rep("pair", length(timesteps)) return(invisible(timesteps)) }