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

Merge 7 fixed functionality into master

parent cdb9fa3b
No related branches found
No related tags found
1 merge request!7Merge 7 fixed functionality into master
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 386 additions and 380 deletions
.Rbuildignore
+ 5
− 0
View file @ fbaaf2c2
......@@ -2,4 +2,9 @@
^\.Rproj\.user$
^packrat/
^\.Rprofile$
^inst/examples/Theis_problem
^inst/examples/Theis_well_pumping
^LICENSE.md
^doc$
^Meta$
^data-raw$
.gitignore
+ 2
− 0
View file @ fbaaf2c2
......@@ -5,3 +5,5 @@
packrat/lib*/
packrat/src/
inst/doc
doc
Meta
DESCRIPTION
+ 2
− 1
View file @ fbaaf2c2
......@@ -43,4 +43,5 @@ Imports:
RoxygenNote: 7.1.1
VignetteBuilder: knitr
Depends:
foreach
foreach,
R (>= 2.10)
R/analyse_xml.R
+ 13
− 16
View file @ fbaaf2c2
......@@ -13,20 +13,17 @@
#' summary of its findings at the end.
#'@param path string: A path
#'@param pattern string: A regex pattern
#'@param tag_name string: The name of the XML element to look for
#'@param xpath_prefix string: Optional: The XPath prefix to use
#' (defaults to "//")
#'@param xpath string: An XPath expression. WARNING: Only works for expressions
#' that return nodesets, use it to look up tag names.
#'@param print_findings Optional: Should the results be printed to the console?
analyse_xml <- function(path,
pattern,
tag_name,
xpath_prefix = "//",
xpath,
print_findings = TRUE) {
path <- validate_is_dir_path(path)
path <- as_dir_path(path)
assertthat::assert_that(assertthat::is.string(pattern))
assertthat::assert_that(assertthat::is.string(tag_name))
assertthat::assert_that(assertthat::is.string(xpath_prefix))
assertthat::assert_that(assertthat::is.string(xpath))
xml_files <- list.files(path = path, pattern = pattern, recursive = TRUE)
......@@ -79,9 +76,7 @@ analyse_xml <- function(path,
valid_files_count <- valid_files_count + 1
valid_files_names <- c(valid_files_names, basename(xml_files[[i]]))
xpath_exp <- paste0(xpath_prefix, tag_name)
doc_matches <- xml2::xml_find_all(xml_doc, xpath_exp)
doc_matches <- xml2::xml_find_all(xml_doc, xpath)
total_matches <- total_matches + length(doc_matches)
if(length(doc_matches) > 0){
......@@ -185,7 +180,7 @@ analyse_xml <- function(path,
invalid_files_count,
invalid_files_names,
valid_files_count,
tag_name,
xpath,
element_found_files_names,
total_matches,
attr_ex_counts,
......@@ -199,7 +194,7 @@ analyse_xml <- function(path,
#Return attributes and children (if found)
return(invisible(
list(
tag_name = tag_name,
xpath = xpath,
children = child_flags,
attributes = attr_flags,
both_sorted = both_flags
......@@ -208,13 +203,13 @@ analyse_xml <- function(path,
}
#=== PRINT FUNCTIONALITY FOR analyse_xml ===
#===== print_analysis_findings =====
print_analysis_findings <- function(invalid_files_count,
invalid_files_names,
valid_files_count,
tag_name,
xpath,
element_found_files_names,
total_matches,
attr_ex_counts,
......@@ -233,6 +228,8 @@ print_analysis_findings <- function(invalid_files_count,
cat("\nI parsed ", valid_files_count,
" valid XML files matching your pattern.\n", sep = "")
tag_name <- get_tag_from_xpath(xpath)
if(length(element_found_files_names) > 0){
cat("\nI found at least one element named ",
tag_name, " in the following file(s):\n", sep = "")
......@@ -259,7 +256,7 @@ print_analysis_findings <- function(invalid_files_count,
}
#=== HELPERS FOR analyse_xml ===
#===== get_required =====
#'get_required
......
R/dataset.R 0 → 100644
+ 10
− 0
View file @ fbaaf2c2
#' xpaths_for_classes
#'
#' Path to the .xml document containing information about the .prj file
#' structure
#'
#' @format list: A named list of character vectors where the names are r2ogs6
#' class names and the values are the corresponding xpaths
"xpaths_for_classes"
\ No newline at end of file
R/export_prj.R
+ 1
− 1
View file @ fbaaf2c2
......@@ -29,7 +29,7 @@ export_prj <- function(ogs6_obj) {
xml2::as_xml_document(meshes_node))
#Get implemented classes
prj_components <- addable_prj_components()
prj_components <- prj_top_level_classes()
# Include file reference
if(names(ogs6_obj$processes)[[1]] == "include"){
......
R/export_utils.R
+ 1
− 1
View file @ fbaaf2c2
......@@ -91,7 +91,7 @@ to_node <- function(object, object_name = "",
}
object_node <- list(structure(list()))
names(object_node)[[1]] <- get_class_tag_name(class_name)
names(object_node)[[1]] <- get_tag_from_class(class_name)
# For normal class variables we just get the parameter value
for(i in seq_len(length(param_names))){
......
R/generate_benchmark_script.R
+ 22
− 27
View file @ fbaaf2c2
......@@ -37,8 +37,8 @@ generate_all_benchmark_scripts <-
missing_read_in_gmls <- missing(read_in_gmls)
path <- validate_is_dir_path(path)
scripts_path <- validate_is_dir_path(scripts_path)
path <- as_dir_path(path)
scripts_path <- as_dir_path(scripts_path)
assertthat::assert_that(assertthat::is.string(starting_from_prj_path))
assertthat::assert_that(is.character(skip_prj_paths))
assertthat::assert_that(assertthat::is.flag(read_in_vtus))
......@@ -50,7 +50,15 @@ generate_all_benchmark_scripts <-
# If we know the benchmarks up to a specific file are working, skip them
if(starting_from_prj_path != ""){
prj_paths <- get_path_sublist(prj_paths, starting_from_prj_path)
if(is.na(match(starting_from_prj_path, prj_paths))){
warning(paste("Couldn't find path to start from.",
"Returning all paths."),
call. = FALSE)
}else{
start_index <- match(starting_from_prj_path, prj_paths)
prj_paths <- prj_paths[start_index:length(prj_paths)]
}
}
invalid_xml_paths <- character()
......@@ -153,7 +161,6 @@ generate_benchmark_script <- function(prj_path,
script_path <- unlist(options("r2ogs6.default_script_path"))
}
assertthat::assert_that(assertthat::is.string(prj_path))
assertthat::assert_that(assertthat::is.string(sim_path))
assertthat::assert_that(assertthat::is.string(ogs_bin_path))
......@@ -163,16 +170,14 @@ generate_benchmark_script <- function(prj_path,
#Construct an object from a benchmark and then reverse engineer the call
ogs6_obj <- OGS6$new(sim_name = "",
sim_id = 1,
sim_path = "",
ogs_bin_path = "",
test_mode = TRUE)
sim_path = "")
read_in_prj(ogs6_obj,
prj_path,
read_in_vtu,
read_in_gml = FALSE)
prj_components = addable_prj_components()
prj_components = prj_top_level_classes()
sim_name <- tools::file_path_sans_ext(basename(prj_path))
......@@ -180,8 +185,7 @@ generate_benchmark_script <- function(prj_path,
"ogs6_obj <- OGS6$new(sim_name = \"",
sim_name, "\",\n",
"sim_id = 1,\n",
"sim_path = \"", sim_path, "\",\n",
"ogs_bin_path = \"", ogs_bin_path, "\")\n\n\n")
"sim_path = \"", sim_path, "\")\n\n\n")
# If there is a .gml but it shouldn't be read in, add reference
if (!is.null(ogs6_obj$geometry)) {
......@@ -202,7 +206,7 @@ generate_benchmark_script <- function(prj_path,
")\n\n"
)
}else{
ogs6_obj$add_gml(read_in_gml(ogs6_obj$geometry))
ogs6_obj$add_gml(OGS6_gml$new(ogs6_obj$geometry))
script_str <- paste0(script_str,
construct_add_call(ogs6_obj$gml),
"\n\n")
......@@ -243,7 +247,9 @@ generate_benchmark_script <- function(prj_path,
}
}
script_str <- paste0(script_str, "run_simulation(ogs6_obj)\n")
script_str <- paste0(script_str,
"run_simulation(ogs6_obj,\n",
"ogs_bin_path = \"", ogs_bin_path, "\")\n")
#If no destination file was defined, print output to console
if(script_path != ""){
......@@ -349,19 +355,11 @@ construct_add_call <- function(object, nested_call = FALSE) {
ret_str <- paste0(class_name, init_prefix,
"(", content_str, ")")
#If call isn't nested, it has a OGS6$add_* function
#If call isn't nested, it can be added
if(!nested_call){
# if(tag_name == "vtu"){
# filename_str <- paste0(",\npaste0(ogs6_obj$sim_path,\n",
# "basename(ogs6_obj$geometry))")
# }
ret_str <- paste0("ogs6_obj$add_", tag_name,
"(", ret_str, ")\n")
ret_str <- paste0("ogs6_obj$add(", ret_str, ")\n")
}
ret_str <- delete_nulls_from_str(ret_str)
ret_str <- delete_keywords_from_str(ret_str)
ret_str <- delete_empty_from_str(ret_str)
......@@ -376,11 +374,8 @@ construct_add_call <- function(object, nested_call = FALSE) {
return(invisible(ret_str))
}
#Positioning is important here - r2ogs6 objects are built on top of lists!
#If is.list is checked before class, results will not be as intended!
#For lists we need to use recursion
if(is.list(object)){
if(class(object) == "list"){
element_strs <- lapply(object, function(x){construct_add_call(x, TRUE)})
......@@ -436,7 +431,7 @@ delete_empty_from_str <- function(string){
#'delete_keywords_from_str
#'@description Utility function to delete keywords from a string,
#' this important because there is a <repeat> tag in <time_loop> and
#' this is important because there is a <repeat> tag in <time_loop> and
#' "repeat" is a reserved word in R (extend this function if you find more
#' reserved words)
#'@param string string
......
R/generate_class.R
+ 10
− 4
View file @ fbaaf2c2
......@@ -21,7 +21,9 @@ generate_constructor <- function(params,
assertthat::assert_that(length(params) == 4)
assertthat::assert_that(assertthat::is.string(prefix))
tag_name <- params[[1]]
xpath <- stringr::str_remove(params[[1]], "\\/[A-Za-z_]*\\/")
tag_name <- get_tag_from_xpath(xpath)
attr_flags <- params[[3]]
param_flags <- params[[4]]
......@@ -45,7 +47,7 @@ generate_constructor <- function(params,
con_str <- paste0(con_str,
"structure(list(",
assign_str, ",\n",
"is_subclass = TRUE,\n",
"xpath = \"", xpath, "\",\n",
"attr_names = c(", attr_names , "),\n",
"flatten_on_exp = character()\n",
"),\n",
......@@ -80,7 +82,9 @@ generate_helper <- function(params,
assertthat::assert_that(length(params) == 4)
assertthat::assert_that(assertthat::is.string(prefix))
tag_name <- params[[1]]
xpath <- stringr::str_remove(params[[1]], "\\/[A-Za-z_]*\\/")
tag_name <- get_tag_from_xpath(xpath)
param_flags <- params[[4]]
class_name <- paste0("r2ogs6_", prefix, tag_name)
......@@ -252,7 +256,9 @@ generate_R6 <- function(params,
assertthat::assert_that(is.list(params))
assertthat::assert_that(length(params) == 4)
tag_name <- params[[1]]
xpath <- stringr::str_remove(params[[1]], "\\/[A-Za-z_]*\\/")
tag_name <- get_tag_from_xpath(xpath)
attr_flags <- params[[3]]
param_flags <- params[[4]]
......
R/generate_xml.R 0 → 100644
+ 108
− 0
View file @ fbaaf2c2
#===== build_redux_doc =====
#'build_redux_doc
#'@description Builds an XML document based on the findings of analyse_xml.
#' Calls recursive function `build_redux_tree` internally.
#'@param path string: See ?analyse_xml
#'@param pattern string: See ?analyse_xml
#'@param xpath string: See ?analyse_xml
#'@param export_path string: Path to export the XML document to
build_redux_doc <- function(path,
pattern,
xpath,
export_path){
if(missing(benchmark_path)){
benchmark_path <- unlist(options("r2ogs6.default_benchmark_path"))
}
assertthat::assert_that(assertthat::is.string(benchmark_path))
# Default to
if(missing(pattern) && missing(xpath)){
pattern <- "\\.prj$"
xpath <- "/OpenGeoSysProject"
}
assertthat::assert_that(assertthat::is.string(pattern))
assertthat::assert_that(assertthat::is.string(xpath))
assertthat::assert_that(assertthat::is.string(export_path))
redux_node <- build_redux_tree(path = benchmark_path,
pattern = pattern,
xpath = xpath,
required = TRUE)
redux_doc <- xml2::as_xml_document(redux_node)
xml2::write_xml(redux_doc, export_path)
return(invisible())
}
#===== build_redux_tree =====
#'build_redux_tree
#'@description Builds an XML tree based on the findings of analyse_xml.
#' This is a recursive function. Handle with care.
#'@param path string: See ?analyse_xml
#'@param pattern string: See ?analyse_xml
#'@param xpath string: See ?analyse_xml
#'@param required flag: Recursion utility
build_redux_tree <- function(path,
pattern,
xpath,
required){
analysis_results <- analyse_xml(path = path,
pattern = pattern,
xpath = xpath,
print_findings = FALSE)
xpath <- analysis_results[["xpath"]]
children <- names(analysis_results[["children"]])
attr_names <- names(analysis_results[["attributes"]])
# Create a redux base node
redux_node <- list(structure(list()))
names(redux_node) <- get_tag_from_xpath(xpath)
attributes(redux_node[[1]])$required <- required
if(length(attr_names) > 0){
attr_names_str <- paste(attr_names, collapse = " ")
attributes(redux_node[[1]])$attr_names <- attr_names_str
}
# Recursion stops here
if(length(children) == 0){
attributes(redux_node[[1]])$read_content_as <- "string"
return(invisible(redux_node))
}
redux_node_attrs <- c(list(read_content_as = "list"),
attributes(redux_node[[1]]))
for(i in seq_len(length(children))){
new_xpath <- paste0(xpath, "/", children[[i]])
required <- analysis_results[["children"]][[i]]
child_redux_node <-
build_redux_tree(path = path,
pattern = pattern,
xpath = new_xpath,
required = required)
redux_node[[1]] <- c(redux_node[[1]],
list(child_redux_node))
}
# Needed because attributes get lost when adding to redux_node[[1]]
attributes(redux_node[[1]]) <- redux_node_attrs
return(invisible(redux_node))
}
R/ogs6.R
+ 128
− 245
View file @ fbaaf2c2
This diff is collapsed.
R/ogs6_ensemble.R
+ 1
− 1
View file @ fbaaf2c2
......@@ -28,7 +28,7 @@ OGS6_Ensemble <- R6::R6Class(
assertthat::assert_that(inherits(ogs6_obj, "OGS6"))
private$.ens_path <- paste0(ogs6_obj$sim_path,
validate_is_dir_path(ens_dir_name))
as_dir_path(ens_dir_name))
ogs6_obj$sim_path <- paste0(private$.ens_path, ogs6_obj$sim_name)
......
R/prj_borehole_heat_exchanger.R
+ 21
− 17
View file @ fbaaf2c2
......@@ -40,23 +40,23 @@ new_r2ogs6_borehole_heat_exchanger <- function(type,
refrigerant,
use_bhe_pipe_network = NULL) {
validate_is_string(type)
are_strings(type)
assertthat::assert_that(class(flow_and_temperature_control) ==
"r2ogs6_flow_and_temperature_control")
borehole <- validate_param_list(borehole, c("length", "diameter"))
grout <- validate_param_list(grout, c("density",
borehole <- coerce_names(borehole, c("length", "diameter"))
grout <- coerce_names(grout, c("density",
"porosity",
"specific_heat_capacity",
"thermal_conductivity"))
assertthat::assert_that(class(pipes) == "r2ogs6_pipes")
refrigerant <- validate_param_list(refrigerant, c("density",
refrigerant <- coerce_names(refrigerant, c("density",
"viscosity",
"specific_heat_capacity",
"thermal_conductivity",
"reference_temperature"))
validate_is_null_or_str_flag(use_bhe_pipe_network)
are_null_or_string_flags(use_bhe_pipe_network)
structure(list(type = type,
flow_and_temperature_control = flow_and_temperature_control,
......@@ -65,7 +65,8 @@ new_r2ogs6_borehole_heat_exchanger <- function(type,
pipes = pipes,
refrigerant = refrigerant,
use_bhe_pipe_network = use_bhe_pipe_network,
is_subclass = TRUE,
xpath = paste0("processes/process/borehole_heat_exchangers/",
"borehole_heat_exchanger"),
attr_names = character(),
flatten_on_exp = character()
),
......@@ -113,13 +114,13 @@ new_r2ogs6_flow_and_temperature_control <- function(type,
power_curve = NULL,
flow_rate_curve = NULL) {
validate_is_string(type)
are_strings(type)
validate_is_null_or_string(temperature_curve,
are_null_or_strings(temperature_curve,
power_curve,
flow_rate_curve)
validate_is_null_or_number(flow_rate,
are_null_or_numbers(flow_rate,
power)
structure(list(type = type,
......@@ -128,7 +129,9 @@ new_r2ogs6_flow_and_temperature_control <- function(type,
power = power,
power_curve = power_curve,
flow_rate_curve = flow_rate_curve,
is_subclass = TRUE,
xpath = paste0("processes/process/borehole_heat_exchangers/",
"borehole_heat_exchanger/",
"flow_and_temperature_control"),
attr_names = character(),
flatten_on_exp = character()
),
......@@ -179,19 +182,19 @@ new_r2ogs6_pipes <- function(longitudinal_dispersion_length,
outer = NULL,
inner = NULL) {
validate_is_number(longitudinal_dispersion_length)
are_numbers(longitudinal_dispersion_length)
inlet_outlet_names <- c("diameter",
"wall_thickness",
"wall_thermal_conductivity")
inlet <- validate_is_null_or_param_list(inlet, inlet_outlet_names)
outlet <- validate_is_null_or_param_list(outlet, inlet_outlet_names)
inlet <- is_null_or_coerce_names(inlet, inlet_outlet_names)
outlet <- is_null_or_coerce_names(outlet, inlet_outlet_names)
validate_is_null_or_number(distance_between_pipes)
are_null_or_numbers(distance_between_pipes)
outer <- validate_is_null_or_param_list(outer, inlet_outlet_names)
inner <- validate_is_null_or_param_list(inner, inlet_outlet_names)
outer <- is_null_or_coerce_names(outer, inlet_outlet_names)
inner <- is_null_or_coerce_names(inner, inlet_outlet_names)
structure(list(longitudinal_dispersion_length =
longitudinal_dispersion_length,
......@@ -200,7 +203,8 @@ new_r2ogs6_pipes <- function(longitudinal_dispersion_length,
distance_between_pipes = distance_between_pipes,
outer = outer,
inner = inner,
is_subclass = TRUE,
xpath = paste0("processes/process/borehole_heat_exchangers/",
"borehole_heat_exchanger/pipes"),
attr_names = character(),
flatten_on_exp = character()
),
......
R/prj_chemical_system.R
+ 15
− 20
View file @ fbaaf2c2
......@@ -46,19 +46,19 @@ new_r2ogs6_chemical_system <- function(chemical_solver,
kinetic_reactants = NULL,
rates = NULL) {
validate_is_string(chemical_solver,
are_strings(chemical_solver,
database)
assertthat::assert_that(class(solution) == "r2ogs6_solution")
validate_is_null_or_string(mesh)
are_null_or_strings(mesh)
if(!is.null(equilibrium_reactants)){
validate_wrapper_list(equilibrium_reactants,
is_wrapper_list(equilibrium_reactants,
"r2ogs6_phase_component")
}
knobs <- validate_is_null_or_param_list(
knobs <- is_null_or_coerce_names(
knobs,
c("max_iter",
"relative_convergence_tolerance",
......@@ -68,12 +68,12 @@ new_r2ogs6_chemical_system <- function(chemical_solver,
)
if(!is.null(kinetic_reactants)){
validate_wrapper_list(kinetic_reactants,
is_wrapper_list(kinetic_reactants,
"r2ogs6_kinetic_reactant")
}
if(!is.null(rates)){
validate_wrapper_list(rates,
is_wrapper_list(rates,
"r2ogs6_rate")
}
......@@ -87,11 +87,7 @@ new_r2ogs6_chemical_system <- function(chemical_solver,
knobs = knobs,
kinetic_reactants = kinetic_reactants,
rates = rates,
is_subclass = FALSE,
subclasses_names = c("r2ogs6_solution",
"r2ogs6_phase_component",
"r2ogs6_kinetic_reactant",
"r2ogs6_rate"),
xpath = "chemical_system",
attr_names = c("chemical_solver"),
flatten_on_exp = character()
),
......@@ -137,14 +133,14 @@ new_r2ogs6_solution <- function(temperature,
components,
charge_balance = NULL) {
validate_is_number(temperature,
are_numbers(temperature,
pressure,
pe)
assertthat::assert_that(is.character(components))
names(components) <- rep("component", length(components))
validate_is_null_or_string(charge_balance)
are_null_or_strings(charge_balance)
structure(
list(
......@@ -153,7 +149,7 @@ new_r2ogs6_solution <- function(temperature,
pe = pe,
components = components,
charge_balance = charge_balance,
is_subclass = TRUE,
xpath = "chemical_system/solution",
attr_names = character(),
flatten_on_exp = character()
),
......@@ -191,7 +187,7 @@ new_r2ogs6_phase_component <- function(name,
assertthat::assert_that(assertthat::is.string(name))
validate_is_number(initial_amount,
are_numbers(initial_amount,
saturation_index)
structure(
......@@ -199,7 +195,7 @@ new_r2ogs6_phase_component <- function(name,
name = name,
initial_amount = initial_amount,
saturation_index = saturation_index,
is_subclass = TRUE,
xpath = "chemical_system/equilibrium_reactants/phase_component",
attr_names = character(),
flatten_on_exp = character()
),
......@@ -241,7 +237,7 @@ new_r2ogs6_kinetic_reactant <- function(name,
assertthat::assert_that(assertthat::is.string(name))
assertthat::assert_that(is.double(initial_amount))
validate_is_null_or_string(chemical_formula,
are_null_or_strings(chemical_formula,
fix_amount)
structure(
......@@ -250,7 +246,7 @@ new_r2ogs6_kinetic_reactant <- function(name,
initial_amount = initial_amount,
chemical_formula = chemical_formula,
fix_amount = fix_amount,
is_subclass = TRUE,
xpath = "chemical_system/kinetic_reactants/kinetic_reactant",
attr_names = character(),
flatten_on_exp = character()
),
......@@ -287,11 +283,10 @@ new_r2ogs6_rate <- function(kinetic_reactant,
list(
kinetic_reactant = kinetic_reactant,
expression = expression,
is_subclass = TRUE,
xpath = "chemical_system/rates/rate",
attr_names = character(),
flatten_on_exp = character()
),
class = "r2ogs6_rate"
)
}
R/prj_curve.R
+ 1
− 1
View file @ fbaaf2c2
......@@ -28,7 +28,7 @@ new_r2ogs6_curve <- function(name, coords, values){
structure(list(name = name,
coords = coords,
values = values,
is_subclass = FALSE,
xpath = "curves/curve",
attr_names = character(),
flatten_on_exp = c("coords", "values")
),
......
R/prj_insitu.R
+ 1
− 2
View file @ fbaaf2c2
......@@ -27,8 +27,7 @@ new_r2ogs6_insitu <- function(scripts) {
structure(
list(
scripts = scripts,
tag_name = "insitu",
is_subclass = FALSE,
xpath = "insitu",
attr_names = character(),
flatten_on_exp = character()
),
......
R/prj_linear_solver.R
+ 6
− 6
View file @ fbaaf2c2
......@@ -30,8 +30,8 @@ new_r2ogs6_linear_solver <- function(name,
assertthat::assert_that(assertthat::is.string(name))
validate_is_null_or_class_obj(eigen, "r2ogs6_eigen")
validate_is_null_or_string(lis)
is_null_or_has_class(eigen, "r2ogs6_eigen")
are_null_or_strings(lis)
if(!is.null(petsc)){
assertthat::assert_that(is.list(petsc))
......@@ -48,7 +48,7 @@ new_r2ogs6_linear_solver <- function(name,
eigen = eigen,
lis = lis,
petsc = petsc,
is_subclass = FALSE,
xpath = "linear_solvers/linear_solver",
attr_names = character(),
flatten_on_exp = character()
),
......@@ -99,9 +99,9 @@ new_r2ogs6_eigen <- function(solver_type,
assertthat::assert_that(assertthat::is.string(solver_type))
validate_is_null_or_string(precon_type,
are_null_or_strings(precon_type,
scaling)
validate_is_null_or_number(max_iteration_step,
are_null_or_numbers(max_iteration_step,
error_tolerance,
restart)
......@@ -111,7 +111,7 @@ new_r2ogs6_eigen <- function(solver_type,
error_tolerance = error_tolerance,
scaling = scaling,
restart = restart,
is_subclass = TRUE,
xpath = "linear_solvers/linear_solver/eigen",
attr_names = character(),
flatten_on_exp = character()
),
......
R/prj_local_coordinate_system.R
+ 2
− 2
View file @ fbaaf2c2
......@@ -22,14 +22,14 @@ new_r2ogs6_local_coordinate_system <- function(basis_vector_0,
assertthat::assert_that(assertthat::is.string(basis_vector_0))
assertthat::assert_that(assertthat::is.string(basis_vector_1))
validate_is_null_or_string(basis_vector_2)
are_null_or_strings(basis_vector_2)
structure(
list(
basis_vector_0 = basis_vector_0,
basis_vector_1 = basis_vector_1,
basis_vector_2 = basis_vector_2,
is_subclass = FALSE,
xpath = "local_coordinate_system",
attr_names = character(),
flatten_on_exp = character()
),
......
R/prj_material_property.R
+ 13
− 13
View file @ fbaaf2c2
......@@ -22,11 +22,11 @@ new_r2ogs6_material_property <- function(fluid,
assertthat::assert_that(class(fluid) == "r2ogs6_fluid")
validate_wrapper_list(porous_medium, "r2ogs6_porous_medium")
is_wrapper_list(porous_medium, "r2ogs6_porous_medium")
structure(list(fluid = fluid,
porous_medium = porous_medium,
is_subclass = TRUE,
xpath = "processes/process/material_property",
attr_names = character(),
flatten_on_exp = character()
),
......@@ -91,46 +91,46 @@ new_r2ogs6_fluid <- function(liquid_density,
type_value_names <- c("type", "value")
liquid_density <- validate_param_list(liquid_density, type_value_names)
liquid_density <- coerce_names(liquid_density, type_value_names)
gas_density <- validate_param_list(gas_density, c("type",
gas_density <- coerce_names(gas_density, c("type",
"molar_mass"))
liquid_viscosity <- validate_param_list(liquid_viscosity, type_value_names)
liquid_viscosity <- coerce_names(liquid_viscosity, type_value_names)
gas_viscosity <- validate_param_list(gas_viscosity, type_value_names)
gas_viscosity <- coerce_names(gas_viscosity, type_value_names)
if(!is.null(specific_heat_capacity_solid)){
specific_heat_capacity_solid <-
validate_param_list(specific_heat_capacity_solid, type_value_names)
coerce_names(specific_heat_capacity_solid, type_value_names)
}
if(!is.null(specific_heat_capacity_water)){
specific_heat_capacity_water <-
validate_param_list(specific_heat_capacity_water, type_value_names)
coerce_names(specific_heat_capacity_water, type_value_names)
}
if(!is.null(specific_heat_capacity_air)){
specific_heat_capacity_air <-
validate_param_list(specific_heat_capacity_air, type_value_names)
coerce_names(specific_heat_capacity_air, type_value_names)
}
if(!is.null(specific_heat_capacity_water_vapor)){
specific_heat_capacity_water_vapor <-
validate_param_list(specific_heat_capacity_water_vapor,
coerce_names(specific_heat_capacity_water_vapor,
type_value_names)
}
if(!is.null(thermal_conductivity_dry_solid)){
thermal_conductivity_dry_solid <-
validate_param_list(thermal_conductivity_dry_solid,
coerce_names(thermal_conductivity_dry_solid,
type_value_names)
}
if(!is.null(thermal_conductivity_wet_solid)){
thermal_conductivity_wet_solid <-
validate_param_list(thermal_conductivity_wet_solid,
coerce_names(thermal_conductivity_wet_solid,
type_value_names)
}
......@@ -147,7 +147,7 @@ new_r2ogs6_fluid <- function(liquid_density,
thermal_conductivity_dry_solid,
thermal_conductivity_wet_solid =
thermal_conductivity_wet_solid,
is_subclass = TRUE,
xpath = "processes/process/material_property/fluid",
attr_names = character(),
flatten_on_exp = character()
),
......
R/prj_medium.R
+ 24
− 23
View file @ fbaaf2c2
......@@ -28,21 +28,21 @@ new_r2ogs6_medium <- function(phases = NULL,
id = NULL) {
if(length(phases) != 0){
validate_wrapper_list(phases, "r2ogs6_phase")
is_wrapper_list(phases, "r2ogs6_phase")
}
if(!is.null(properties)){
validate_wrapper_list(properties, "r2ogs6_pr_property")
is_wrapper_list(properties, "r2ogs6_pr_property")
}
validate_is_null_or_string(id)
are_null_or_strings(id)
structure(
list(
phases = phases,
properties = properties,
id = id,
is_subclass = FALSE,
xpath = "media/medium",
attr_names = c("id"),
flatten_on_exp = character()
),
......@@ -224,9 +224,9 @@ new_r2ogs6_pr_property <- function(name,
assertthat::assert_that(assertthat::is.string(name))
assertthat::assert_that(assertthat::is.string(type))
validate_is_null_or_numeric(value)
are_null_or_numeric(value)
validate_is_null_or_number(exponent,
are_null_or_numbers(exponent,
residual_liquid_saturation,
residual_gas_saturation,
p_b,
......@@ -243,7 +243,7 @@ new_r2ogs6_pr_property <- function(name,
min_relative_permeability_liquid,
min_relative_permeability_gas)
validate_is_null_or_string(parameter_name,
are_null_or_strings(parameter_name,
independent_variable,
curve,
initial_permeability)
......@@ -282,7 +282,7 @@ new_r2ogs6_pr_property <- function(name,
entry_pressure = entry_pressure,
min_relative_permeability_liquid = min_relative_permeability_liquid,
min_relative_permeability_gas = min_relative_permeability_gas,
is_subclass = TRUE,
xpath = "media/medium/properties/property",
attr_names = character(),
flatten_on_exp = character()
),
......@@ -322,11 +322,11 @@ new_r2ogs6_phase <- function(type,
assertthat::assert_that(type %in% get_valid_phase_types())
if(!is.null(properties)){
validate_wrapper_list(properties, "r2ogs6_ph_property")
is_wrapper_list(properties, "r2ogs6_ph_property")
}
if(!is.null(components)){
validate_wrapper_list(components, "r2ogs6_component")
is_wrapper_list(components, "r2ogs6_component")
}
structure(
......@@ -334,7 +334,7 @@ new_r2ogs6_phase <- function(type,
type = type,
properties = properties,
components = components,
is_subclass = TRUE,
xpath = "media/medium/phases/phase",
attr_names = character(),
flatten_on_exp = character()
),
......@@ -451,26 +451,26 @@ new_r2ogs6_ph_property <- function(name,
assertthat::assert_that(assertthat::is.string(name))
assertthat::assert_that(assertthat::is.string(type))
validate_is_null_or_numeric(value)
are_null_or_numeric(value)
validate_is_null_or_number(reference_value,
are_null_or_numbers(reference_value,
minimal_porosity,
maximal_porosity,
offset,
lower_saturation_limit,
upper_saturation_limit)
validate_is_null_or_numeric(exponents,
are_null_or_numeric(exponents,
swelling_pressures,
intrinsic_permeabilities)
validate_is_null_or_string(initial_porosity,
are_null_or_strings(initial_porosity,
parameter_name)
if (!is.null(independent_variable)) {
for(i in seq_len(length(independent_variable))){
independent_variable[[i]] <-
validate_param_list(independent_variable[[i]],
coerce_names(independent_variable[[i]],
c("variable_name",
"reference_condition",
"slope"))
......@@ -478,7 +478,7 @@ new_r2ogs6_ph_property <- function(name,
}
if (!is.null(exponent)) {
exponent <- validate_param_list(exponent,
exponent <- coerce_names(exponent,
c("variable_name",
"reference_condition",
"factor"))
......@@ -502,7 +502,7 @@ new_r2ogs6_ph_property <- function(name,
lower_saturation_limit = lower_saturation_limit,
upper_saturation_limit = upper_saturation_limit,
intrinsic_permeabilities = intrinsic_permeabilities,
is_subclass = TRUE,
xpath = "media/medium/phases/phase/properties/property",
attr_names = character(),
flatten_on_exp = c("exponents",
"swelling_pressures",
......@@ -538,13 +538,13 @@ new_r2ogs6_component <- function(name,
assertthat::assert_that(assertthat::is.string(name))
validate_wrapper_list(properties, "r2ogs6_com_property")
is_wrapper_list(properties, "r2ogs6_com_property")
structure(
list(
name = name,
properties = properties,
is_subclass = TRUE,
xpath = "media/medium/phases/phase/components/component",
attr_names = character(),
flatten_on_exp = character()
),
......@@ -588,8 +588,8 @@ new_r2ogs6_com_property <- function(name,
assertthat::assert_that(assertthat::is.string(name))
assertthat::assert_that(assertthat::is.string(type))
validate_is_null_or_number(value)
validate_is_null_or_string(parameter_name)
are_null_or_numbers(value)
are_null_or_strings(parameter_name)
structure(
list(
......@@ -597,7 +597,8 @@ new_r2ogs6_com_property <- function(name,
type = type,
value = value,
parameter_name = parameter_name,
is_subclass = TRUE,
xpath = paste0("media/medium/phases/phase/components/component",
"properties/property"),
attr_names = character(),
flatten_on_exp = character()
),
......
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