Code owners
Assign users and groups as approvers for specific file changes. Learn more.
prj_time_loop.R 16.85 KiB
#===== 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))
}