diff --git a/NAMESPACE b/NAMESPACE index af76d821d72f8da42d0930dd0ea697cb48241e95..52615129209664fa3ab71063afc17af3fc962a62 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,14 @@ # Generated by roxygen2: do not edit by hand +S3method(SicInput,POSIXt) +S3method(SicInput,data.frame) +S3method(SicInput,matrix) +S3method(SicInput,numeric) +S3method(merge,SicInput) +export(SicInput) +export(SicLocation) +export(SicLocations) export(cfg_tmp_project) -export(convert_sic_params) export(create_section_txt) export(create_uniform_reach_txt) export(dem_to_reach) @@ -17,7 +24,10 @@ export(read_bin_result_matrix) export(set_initial_conditions) export(sic_import_reaches) export(sic_run_export) -export(sic_run_fortran) +export(sic_run_mesh) +export(sic_run_steady) +export(sic_run_unsteady) +export(sic_write_par) export(split_reach) import(magrittr) import(utils) diff --git a/R/convert_sic_params.R b/R/convert_sic_params.R index 2d8a24a3502845109d6b1affcfd34e652085b91e..8b137891791fe96927ad78e64b0aad7bded08bdc 100644 --- a/R/convert_sic_params.R +++ b/R/convert_sic_params.R @@ -1,26 +1 @@ -#' Convert a list of parameters into command line arguments for Fortran SIC programs -#' -#' This function is called by [sic_run_fortran] to convert list of parameters into a [character] command line parameters. -#' -#' The parameter `INTERF` is set to 0 (zero) by default. -#' -#' @param params a [list] of [character] containing the parameters to send to the fortran program with format `list(param=value, ...)` -#' @template param_cfg -#' -#' @return A [character] with each parameter is converted to `[key param]=[value param]` and each parameter separated by a space character. -#' @export -#' -#' @examples -#' \dontrun{ -#' cfg <- cfg_tmp_project() -#' convert_sic_params(list(SCE = 1, VAR = 1), cfg = cfg) -#' } -convert_sic_params <- function(params, cfg = loadConfig()) { - if (!"INTERF" %in% names(params)) { - params <- c(list(INTERF = cfg$sic$fortran$prms$INTERF), params) - } - params <- sapply(names(params), function(key) { - paste(key, params[[key]], sep= "=") - }) - paste(params, collapse = " ") -} + diff --git a/R/get_result.R b/R/get_result.R index dea3db655cbabb3790c093abbb26a5013e5e9552..f4f358262ce9935ae82922d4aadb80000c5810ae 100644 --- a/R/get_result.R +++ b/R/get_result.R @@ -1,6 +1,6 @@ #' Get a selection of variables from a simulation result #' -#' @inheritParams sic_run_export +#' @inheritParams sic_run_mesh #' @param filters [character] conditions to select columns in result table, see details #' @param m [matrix] of results produced by [read_bin_result_matrix] #' @@ -11,7 +11,7 @@ #' @examples #' \dontrun{ #' cfg <- cfg_tmp_project() -#' sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) +#' sic_run_steady(cfg, scenario = 1) #' get_result(cfg, 1, filters = c("bf==4", "var=='Z'")) #' } get_result <- function(cfg, @@ -47,7 +47,7 @@ get_result <- function(cfg, #' Read matrix of SIC simulation result file #' -#' @inheritParams sic_run_export +#' @inheritParams sic_run_mesh #' #' @return [matrix] with the simulation results #' @export @@ -55,7 +55,7 @@ get_result <- function(cfg, #' @examples #' \dontrun{ #' cfg <- cfg_tmp_project() -#' sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) +#' sic_run_steady(cfg, scenario = 1) #' m <- read_bin_result_matrix(cfg, 1) #' str(m) #' } @@ -90,7 +90,7 @@ read_bin_result_matrix <- function(cfg, scenario, variant = 0) { #' Get correspondence between network object and columns in result binary file #' -#' @inheritParams sic_run_export +#' @inheritParams sic_run_mesh #' #' @return a [data.frame] with following columns: #' @@ -98,7 +98,7 @@ read_bin_result_matrix <- function(cfg, scenario, variant = 0) { #' - "var": the name of the calculated variable #' - "col": the column number in the matrix produced by [read_bin_result_matrix] #' -#' @warning +#' @section Warning: #' Up to now, this function only handle results at sections. #' #' @export @@ -108,7 +108,7 @@ read_bin_result_matrix <- function(cfg, scenario, variant = 0) { #' @examples #' \dontrun{ #' cfg <- cfg_tmp_project() -#' sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) +#' sic_run_steady(cfg, scenario = 1) #' df <- get_result_tree(cfg, 1) #' head(df) #' } diff --git a/R/set_initial_conditions.R b/R/set_initial_conditions.R index 9c4bf9dafcb8c311b4ba567afa5acf944c9775c9..a0ce6d6772e99cd3ce5e1f04e2890ab98312be72 100644 --- a/R/set_initial_conditions.R +++ b/R/set_initial_conditions.R @@ -2,30 +2,25 @@ #' #' Import initial conditions from a scenario/variant result calculation to a new scenario/variant. #' -#' @param params [numeric], arguments passed to Edisic for importing initial conditions. See details +#' @param iniParams [numeric], arguments passed to Edisic for importing initial conditions. See details #' @template param_cfg #' -#' @details `params` [numeric] vector of length 5. Each number correspond to: +#' @details `iniParams` [numeric] vector of length 5. Each number correspond to: #' #' 1. number of the scenario from which import initial conditions -#' 1. number of the variant from which import initial conditions (Use "0" for no variant) -#' 1. Time in seconds of the initial conditions to import (Use "0" for a single permanent simulation with no time steps) -#' 1. number of the scenario where the initial conditions are exported to -#' 1. number of the variant where the initial conditions are exported to (Use "0" for no variant) +#' 2. number of the variant from which import initial conditions (Use "0" for no variant) +#' 3. Time in seconds of the initial conditions to import (Use "0" for a single permanent simulation with no time steps) +#' 4. number of the scenario where the initial conditions are exported to +#' 5. number of the variant where the initial conditions are exported to (Use "0" for no variant) #' #' @export #' -#' @examples -#' \dontrun{ -#' # Import initial conditions from the scenario #1 without variant at time 0s -#' # to the variant #1 in the scenario #1 -#' set_initial_conditions(c(1, 0, 0, 1, 1)) -#' } -set_initial_conditions <- function(params, cfg = loadConfig()) { - if (!is.numeric(params) || length(params) != 5) { - stop("`params` should be a numeric of length 5") +#' @inherit sic_run_mesh return examples +set_initial_conditions <- function(iniParams, cfg = loadConfig()) { + if (!is.numeric(iniParams) || length(iniParams) != 5) { + stop("`iniParams` should be a numeric of length 5") } - sArgs <- paste(params, collapse = " ") + sArgs <- paste(iniParams, collapse = " ") cmd_line <- shQuote( paste( file.path(cfg$sic$path, cfg$sic$edisic), diff --git a/R/sic_inputs.R b/R/sic_inputs.R new file mode 100644 index 0000000000000000000000000000000000000000..f1c2d0bb724ce0de4434433374d45a704bdcf23b --- /dev/null +++ b/R/sic_inputs.R @@ -0,0 +1,270 @@ +#' Get PAR filename for a given scenario in a SIC project +#' +#' @inheritParams sic_run_export +#' +#' @return A [character] with the path of the PAR file +#' @noRd +#' +sic_get_par_filename <- function(cfg, scenario) { + x <- read_xml(cfg$project$path) + xPath <- sprintf("/Reseau/Flu[@nScenario=%d]/NomFicPar", scenario) + file <- x %>% xml_find_first(xPath) %>% xml_text + return(file.path(dirname(cfg$project$path), file)) +} + +#' Write a PAR file for SIC simulation +#' +#' Write inputs in a PAR file respectively to \url{https://sic.g-eau.fr/Format-of-the-par-file}. +#' +#' @inheritParams sic_run_mesh +#' +#' @return Nothing. +#' @export +#' +#' @examples +#' \dontrun{ +#' # Setting the model configuration +#' cfg <- cfg_tmp_project() +#' +#' # How to impose an hydrograph at the upstream offtake of the model? +#' # Define the location of the upstream boundary condition to set +#' locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q")) +#' # Define its time series +#' sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds +#' v = c(5, 20, 5)), # flows +#' locations = locations) +#' # Write the parameters in the PAR file +#' sic_write_par(cfg, 1, sicInputs) +#' } +sic_write_par <- function(cfg, scenario, sicInputs) { + + if (is.null(attr(cfg, "config"))) { + stop("`cfg` should be created with `loadConfig()`") + } + stopifnot(is.numeric(scenario), + length(scenario) == 1, + inherits(sicInputs, "SicInput") || inherits(sicInputs, "SicInputs")) + if (inherits(sicInputs, "SicInput")) sicInputs <- merge(sicInputs) + + sParFileName = sic_get_par_filename(cfg, scenario) + + df = data.frame(C1 = "// PAR file for SIC", + C2 = "automatically generated by rsci2", + C3 = "", + stringsAsFactors = FALSE) + i = 0 + for (input in sicInputs) { + i = i + 1 + # Localisation + if (is.null(input$locations)) { + dfLoc <- NULL + } else { + dfLoc <- data.frame(C1 = paste0("L", i), C2 = input$locations, C3 = "", stringsAsFactors = FALSE) + } + if (is.data.frame(input$data)) { + dfHeader <- data.frame(C1 = paste0("X", i), C2 = "LOI", C3 = ifelse(input$interpolated, "R", "E")) + dfData <- cbind(rep(paste0("X", i), nrow(input$data)), input$data) + names(dfData) <- names(df) + dfData <- rbind(dfHeader, dfData) + } else { + dfData <- data.frame(C1 = paste0("X", i), C2 = input$data, C3 = "") + } + df = rbind(df, dfLoc, dfData) + } + write.table(df, file = sParFileName, col.names = F, row.names = F, sep = "\t", quote = F) +} + +#' Create a SIC input for a PAR file +#' +#' @param x either a fixed input, a [numeric] vector of time in seconds, +#' a [POSIXt] vector of time, a [matrix] or a [data.frame] with 2 columns (time and value) +#' @param values a [numeric] vector used if `x` is a vector of [numeric] or [POSIXt] +#' @param start a [POSIXt] indicating the start time to use as time zero in the simulation +#' @param locations input locations created with [SicLocation] or [SicLocations] +#' @param interpolated Interpolation mode `TRUE` for "ramp" mode and `FALSE` for "step" mode +#' @param ... used for S3 method compatibility +#' +#' @return A *SicInput* object which is a list with the following items: +#' +#' - `locations`: a [SicLocations] object +#' - `data`: [numeric], the fixed value, or [data.frame], the time series to apply to the locations +#' - `interpolated`: [logical], interpolation mode +#' +#' @rdname SicInput +#' @family SicInput +#' @export +#' +#' @examples +#' # How to impose 5 m3/s in the upstream offtake of the model? +#' # Define location of the boundary condition to set +#' locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q")) +#' # Define its value +#' sicInputs <- SicInput(5, locations = locations) +#' +#' # How to impose an hydrograph at the upstream offtake of the model? +#' sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds +#' v = c(5, 20, 5)), # flows +#' locations = locations) +SicInput <- function(x, ...) { + UseMethod("SicInput", x) +} + +#' @rdname SicInput +#' @export +SicInput.numeric <- function(x, values = NULL, locations, interpolated = TRUE, ...) { + if (!(inherits(locations, "SicLocation") || inherits(locations, "SicLocations"))){ + stop("`locations` should be of class 'SicLocation' or 'SicLocations'") + } + if (is.null(values)) { + if (length(x) != 1) + stop("For a single value `x` should be of length 1") + data <- x + } else { + if (length(x) != length(values)) + stop("Lenghts of `x` and `values`should be equal.") + data <- data.frame(t = x, + v = values) + } + sicInput <- list( + locations = locations, + data = data, + interpolated = interpolated + ) + class(sicInput) <- c("SicInput", class(sicInput)) + return(sicInput) +} + +#' @rdname SicInput +#' @export +SicInput.POSIXt <- function(x, values, start = NULL, ...) { + if (is.null(start)) start = x[1] + if (!inherits(start, "POSIXt")) + stop("`start` should be of class 'POSIXt'.") + + # Conversion in seconds + x <- as.numeric(difftime(x, start, units = "secs")) + + if (any(x < 0)) + stop("Negative time detected. Check the start time or the time series order.") + + SicInput(x, values, ...) +} + +#' @rdname SicInput +#' @export +SicInput.data.frame <- function(x, ...) { + SicInput(x[,1], x[, 2], ...) +} + +#' @rdname SicInput +#' @export +SicInput.matrix <- function(x, ...) { + SicInput(x[,1], x[, 2], ...) +} + +#' Merge SicInput objects into a list +#' +#' @param x a [SicInput] object to merge +#' @param y a [SicInput] object to merge +#' @param ... other [SicInput] objects to merge +#' +#' @details The list of parameter is compliant with the `merge` S3 method +#' available in R, so this method can either be called by typing +#' `merge` or `merge.SicInput`. +#' +#' @return A `SicInputs` object which is a list of [SicInput] +#' @export +#' +#' @examples +#' # How to impose 5 m3/s in the upstream offtake of the model? +#' # Define location of the boundary condition to set +#' locations <- SicLocation(list(Nd = 1, Pr = 1, car = "Q")) +#' # Define its value +#' sicInputUpstream <- SicInput(5, locations = locations) +#' +#' # Opening a gate at 0.5 m +#' sicInputGate <- SicInput( +#' 0.5, +#' locations = SicLocations(list(Bf = 3, Sn = 2, Ouv = 1, Car = "Ouverture")) +#' ) +#' +#' # Merging all inputs +#' sicInputs <- merge(sicInputUpstream, sicInputGate) +#' +merge.SicInput <- function(x, y = NULL, ...) { + sicInputs <- list(x, y, ...) + sicInputs[sapply(sicInputs, is.null)] <- NULL + class(sicInputs) <- c("SicInputs", class(sicInputs)) + return(sicInputs) +} + +#' Set locations of a SIC model input +#' +#' Do the same as [SicLocation] for eventually several locations +#' +#' @param ... One or several [list] describing a location (See [SicLocation]) +#' +#' @return a *SicLocations* object which is a [list] of [SicLocation]. +#' @family SicInput +#' @export +#' +#' @examples +#' # Applying the same flow to offtakes located in nodes number 1 to 10 +#' locations <- lapply(seq(10), function(i) { list(Nd = i, Pr = 1, Car = "Q")}) +#' locations <- do.call(SicLocations, locations) +#' sicInputOfftakes <- SicInput(-0.5, locations = locations) +SicLocations <- function(...) { + locations <- list(...) + if (length(locations) == 1) locations <- locations[[1]] + # Handle a single location in the parameters + if (length(locations[[1]]) == 1) locations <- list(locations) + if(!is.list(locations)) stop("`locations` must be a list") + l <- sapply(locations, SicLocation) + class(l) <- c("SicLocations", class(l)) + return(l) +} + +#' Set a location of a SIC model input +#' +#' @param location a [list] containing the location keys (see details) +#' +#' @return a *SicLocation* object which is a [character] string in the same format as the locations described in the sic documentation of PAR files: \url{https://sic.g-eau.fr/Format-of-the-par-file}. +#' +#' @family SicInput +#' @export +#' +#' @inherit SicInput return examples +#' +SicLocation <- function(location) { + names(location) <- toupper(names(location)) + # Checks + availLoc <- c("BF", "ND", "PR", "ST", "OUV", "SN", "PBF", "CAR") + availCar <- c("Q", "Z", "KMin", "KMoy", "Inf", "CoteRadier", "Largeur", + "Ouverture", "CoefQR", "SurverseHauteur", "CoefQSurverse", + "TanAl", "CoefQT", "CoteAxe", "Rayon", "D", "JMax", "S1S2", + "Decal", "Decrement", "CoteAmont") + if (!is.list(location)) stop("Each `location` must be a list") + if (!"CAR" %in% names(location)) stop("Each location should have at least an item 'CAR'") + if (!any(names(location) %in% c("BF", "ND"))) + stop("a location should have at least an item 'BF' or 'ND'") + dfIncompat <- expand.grid(c("BF", "SN", "PBF"), c("ND", "PR", "ST")) + lapply(seq_len(nrow(dfIncompat)), function(i) { + if (all(unlist(dfIncompat[i, ]) %in% names(location))) + stop("These items can't be together in a location: ", paste(paste0("'", unlist(dfIncompat[i, ]), "'"), collapse = ", ")) + }) + if (any(names(location) %in% c("SN", "PBF")) & !"BF" %in% names(location)) + stop("Location with 'SN' or 'PBF' item should have an item 'BF'") + # Create location string + l <- lapply(names(location), function(objType) { + if (!objType %in% availLoc) stop("Unknown location type: ", objType) + if (objType == "CAR" && !location[[objType]] %in% availCar) + stop("Value '", location[[objType]], "' of item 'CAR' unsupported. It should be one of: ", + paste(paste0("'", availCar, "'"), sep = ", ")) + if (objType != "CAR" && !is.numeric(location[[objType]])) + stop("Item '", objType, "' should be numeric.") + return(paste(objType, location[[objType]], sep = "=")) + }) + s <- paste(unlist(l), collapse = "\t") + class(s) <- c("SicLocation", class(s)) + return(s) +} diff --git a/R/sic_run_export.R b/R/sic_run_export.R index bf56ec78ccdec5faaab735c7569e733dcb90a139..cf14f8a2b2dc4ec1072b52bba86862476874a0fa 100644 --- a/R/sic_run_export.R +++ b/R/sic_run_export.R @@ -2,9 +2,7 @@ #' #' @details #' `params` parameter is a list representing parameters available in \url{https://sic.g-eau.fr/sicexport-utilitaire-d-exportation} to set the model network location of exported results. The string parameter `/x=n /yy=ii` in the command line is here represented by `list(xxx = nnn, yy = ii)`. -#' -#' @param scenario [numeric], the scenario to read -#' @param variant [numeric], the variant to read +#' @inheritParams sic_run_mesh #' @param params [list] location parameters of the result, see details. #' @template param_cfg #' @@ -14,7 +12,7 @@ #' @examples #' \dontrun{ #' params <- list(SCE=1) -#' sic_run_fortran("fluvia", params) +#' sic_run_steady(cfg, scenario = 1) #' # For exporting result in sections at time 0 #' sic_run_export(scenario = 1, params = list(t = 0)) #' } diff --git a/R/sic_run_fortran.R b/R/sic_run_fortran.R index cb649c5f976be647b5ddc7c02c74e227a23eb267..759dd529b59ef59862cf2112666eeba6e090063d 100644 --- a/R/sic_run_fortran.R +++ b/R/sic_run_fortran.R @@ -1,23 +1,81 @@ -#' Run Talweg, Fluvia or Sirene +#' Run Talweg, Fluvia or Sirene for a configured project #' -#' @param prog [character], the program to run. Should be one of "talweg" +#' Use `sic_run_mesh` to run the mesh generator, `sic_run_steady` for steady flow +#' simulation, and `sic_run_unsteady` for unsteady flow simulation. +#' +#' @param scenario [numeric], the scenario to use +#' @param variant [numeric], the variant to use (0 by default means no variant) #' @param params [list] or [character], see details +#' @param sicInputs A [SicInput] object or a list of [SicInput] objects create by [merge.SicInput] +#' used to create a PAR file injectig inputs for the simulation +#' @param iniParams 5-length [numeric] [vector], see [set_initial_conditions] for details #' @template param_cfg #' -#' @details If argument `params` is a [list], arguments are injected in the command line by taking the items of the list with the conversion -#' `[key]=[value]`. If argument `params` is a [character] +#' @details The argument `params` handles the parameters describe in +#' [SIC documentation](https://sic.g-eau.fr/Execution-de-TALWEG-FLUVIA-et). +#' If argument `params` is a [list], arguments are injected in the command line +#' by taking the items of the list with the conversion `[key]=[value]`. +#' By default, the parameter `INTERF=0` is added to the command line. +#' If argument `params` is a [character] string it is directly used as parameters of the command line. #' #' @return Error code returned by [shell]. #' @export #' #' @examples #' \dontrun{ +#' # Set up the configuration model +#' cfg <- cfg_tmp_project() +#' +#' # Generate the mesh of the model +#' sic_run_mesh(cfg) +#' #' # Run steady simulation for the scenario #1 +#' sic_run_steady(cfg, scenario = 1) +#' +#' # Import initial condition from scenario 1 +#' # to scenario 1, variant 1 for unsteady flow simulation +#' set_initial_conditions(c(1, 0, 0, 1, 1), cfg = cfg) +#' +#' # Run unsteady flow simulation +#' sic_run_unsteady(cfg, scenario = 1, variant = 1) +#' +#' # Or initiate and run the same unsteady flow simulation in one call +#' sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1)) +#' } +sic_run_mesh <- function(cfg, params = list()) { + sic_run_fortran(cfg, "talweg", params) +} + +#' Convert a list of parameters into command line arguments for Fortran SIC programs +#' +#' This function is called by [sic_run_fortran] to convert list of parameters into a [character] command line parameters. +#' +#' The parameter `INTERF` is set to 0 (zero) by default. +#' +#' @param params a [list] of [character] containing the parameters to send to the fortran program with format `list(param=value, ...)` +#' @template param_cfg +#' +#' @return A [character] with each parameter is converted to `[key param]=[value param]` and each parameter separated by a space character. +#' @noRd +#' +#' @examples +#' \dontrun{ #' cfg <- cfg_tmp_project() -#' params <- list(SCE=1) -#' sic_run_fortran("fluvia", params, cfg = cfg) -#'} -sic_run_fortran <- function(prog, params = list(), cfg = loadConfig()) { +#' convert_sic_params(list(SCE = 1, VAR = 1), cfg = cfg) +#' } +convert_sic_params <- function(params, cfg = loadConfig()) { + if (!"INTERF" %in% names(params)) { + params <- c(list(INTERF = cfg$sic$fortran$prms$INTERF), params) + } + params <- sapply(names(params), function(key) { + paste(key, params[[key]], sep= "=") + }) + paste(params, collapse = " ") +} + +#' @param prog [character], the program to run. Should be one of "talweg" +#' @noRd +sic_run_fortran <- function(cfg, prog, params) { if (is.list(params)) params <- convert_sic_params(params, cfg) cmd_line <- shQuote( paste( @@ -28,11 +86,36 @@ sic_run_fortran <- function(prog, params = list(), cfg = loadConfig()) { type = "cmd2" ) logger::log_debug(cmd_line) - ret <- shell( + shell( cmd_line, wait = T, translate = T ) - file.remove("FLUVIA.INI", "SIRENE.INI") - return(ret) +} + +#' @noRd +sic_run_simulation <- function(cfg, prog, scenario, variant, sicInputs, params) { + if (!is.null(sicInputs)) { + sic_write_par(cfg, scenario, sicInputs) + } + params <- c(list(SCE = scenario, VAR = variant), params) + sic_run_fortran(cfg, prog, params) +} + +#' @rdname sic_run_mesh +#' @export +sic_run_steady <- function(cfg, scenario, variant = 0, sicInputs = NULL, params = list()) { + sic_run_simulation(cfg, "fluvia", scenario, variant, sicInputs, params) +} + +#' @rdname sic_run_mesh +#' @export +sic_run_unsteady <- function(cfg, scenario = iniParams[4], variant = iniParams[5], sicInputs = NULL, iniParams = NULL, params = list()) { + if (!is.null(iniParams)) { + sic_run_steady(cfg, scenario = iniParams[1], variant = iniParams[1]) + set_initial_conditions(iniParams, cfg) + } + if (is.null(scenario)) stop("`scenario` should be defined") + if (is.null(variant)) variant <- 0 + sic_run_simulation(cfg, "sirene", scenario, variant, sicInputs, params) } diff --git a/R/split_reach.R b/R/split_reach.R index e6850990aa4c84384dd99acf7b0ab4e05e33e76b..ce02a351cc284107f447cbaa60d79c12757bd5b4 100644 --- a/R/split_reach.R +++ b/R/split_reach.R @@ -7,6 +7,21 @@ #' @export #' #' @examples +#' # Create a 10km long trapezoidal uniform reach +#' profT <- list( +#' B = 2, +#' S = (6 - 2) / 2 / 2, +#' ZF = 100, +#' ZB = 100 + 2 +#' ) +#' min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100), +#' upstream_bed_elevation = 10 + 2000 * 0.002, +#' slope = 0.002, +#' section_type = "T", +#' profile = profT) +#' # Split into reaches of 2000 m +#' reaches <- split_reach(min_reach, seq(0, 10000, 2000)) +#' split_reach <- function(reach, x_limits) { if(length(x_limits) < 2) { stop("`x_limits` length must be greater or equal to 2") @@ -16,6 +31,8 @@ split_reach <- function(reach, x_limits) { #' Select portion of a reach between two chainages #' +#' This function is used by [split_reach] for selecting sections of each reach. +#' #' @param reach A ReachTxt object #' @param x_limits 2-length [numeric], min and max chainage #' @@ -23,6 +40,21 @@ split_reach <- function(reach, x_limits) { #' @export #' #' @examples +#' # Create a 10km long trapezoidal uniform reach +#' profT <- list( +#' B = 2, +#' S = (6 - 2) / 2 / 2, +#' ZF = 100, +#' ZB = 100 + 2 +#' ) +#' min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100), +#' upstream_bed_elevation = 10 + 2000 * 0.002, +#' slope = 0.002, +#' section_type = "T", +#' profile = profT) +#' # Extract sections between chainage 2000 m and 4000 m +#' sel_reach <- extract_reach(min_reach, c(2000, 4000)) +#' extract_reach <- function(reach, x_limits) { reach_names <- names(reach) x_limits <- sprintf("%08d", x_limits) diff --git a/man/SicInput.Rd b/man/SicInput.Rd new file mode 100644 index 0000000000000000000000000000000000000000..69623cb32ada80f7a530598c63c3b33e7e1713f2 --- /dev/null +++ b/man/SicInput.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sic_inputs.R +\name{SicInput} +\alias{SicInput} +\alias{SicInput.numeric} +\alias{SicInput.POSIXt} +\alias{SicInput.data.frame} +\alias{SicInput.matrix} +\title{Create a SIC input for a PAR file} +\usage{ +SicInput(x, ...) + +\method{SicInput}{numeric}(x, values = NULL, locations, interpolated = TRUE, ...) + +\method{SicInput}{POSIXt}(x, values, start = NULL, ...) + +\method{SicInput}{data.frame}(x, ...) + +\method{SicInput}{matrix}(x, ...) +} +\arguments{ +\item{x}{either a fixed input, a \link{numeric} vector of time in seconds, +a \link{POSIXt} vector of time, a \link{matrix} or a \link{data.frame} with 2 columns (time and value)} + +\item{...}{used for S3 method compatibility} + +\item{values}{a \link{numeric} vector used if \code{x} is a vector of \link{numeric} or \link{POSIXt}} + +\item{locations}{input locations created with \link{SicLocation} or \link{SicLocations}} + +\item{interpolated}{Interpolation mode \code{TRUE} for "ramp" mode and \code{FALSE} for "step" mode} + +\item{start}{a \link{POSIXt} indicating the start time to use as time zero in the simulation} +} +\value{ +A \emph{SicInput} object which is a list with the following items: +\itemize{ +\item \code{locations}: a \link{SicLocations} object +\item \code{data}: \link{numeric}, the fixed value, or \link{data.frame}, the time series to apply to the locations +\item \code{interpolated}: \link{logical}, interpolation mode +} +} +\description{ +Create a SIC input for a PAR file +} +\examples{ +# How to impose 5 m3/s in the upstream offtake of the model? +# Define location of the boundary condition to set +locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q")) +# Define its value +sicInputs <- SicInput(5, locations = locations) + +# How to impose an hydrograph at the upstream offtake of the model? +sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds + v = c(5, 20, 5)), # flows + locations = locations) +} +\seealso{ +Other SicInput: +\code{\link{SicLocations}()}, +\code{\link{SicLocation}()} +} +\concept{SicInput} diff --git a/man/SicLocation.Rd b/man/SicLocation.Rd new file mode 100644 index 0000000000000000000000000000000000000000..919d056c37b8cd6ccf493549914fd4b32ec9538a --- /dev/null +++ b/man/SicLocation.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sic_inputs.R +\name{SicLocation} +\alias{SicLocation} +\title{Set a location of a SIC model input} +\usage{ +SicLocation(location) +} +\arguments{ +\item{location}{a \link{list} containing the location keys (see details)} +} +\value{ +a \emph{SicLocation} object which is a \link{character} string in the same format as the locations described in the sic documentation of PAR files: \url{https://sic.g-eau.fr/Format-of-the-par-file}. +} +\description{ +Set a location of a SIC model input +} +\examples{ +# How to impose 5 m3/s in the upstream offtake of the model? +# Define location of the boundary condition to set +locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q")) +# Define its value +sicInputs <- SicInput(5, locations = locations) + +# How to impose an hydrograph at the upstream offtake of the model? +sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds + v = c(5, 20, 5)), # flows + locations = locations) +} +\seealso{ +Other SicInput: +\code{\link{SicInput}()}, +\code{\link{SicLocations}()} +} +\concept{SicInput} diff --git a/man/SicLocations.Rd b/man/SicLocations.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fbb1cd58ee3466572d6beddc0a27c5207cfba345 --- /dev/null +++ b/man/SicLocations.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sic_inputs.R +\name{SicLocations} +\alias{SicLocations} +\title{Set locations of a SIC model input} +\usage{ +SicLocations(...) +} +\arguments{ +\item{...}{One or several \link{list} describing a location (See \link{SicLocation})} +} +\value{ +a \emph{SicLocations} object which is a \link{list} of \link{SicLocation}. +} +\description{ +Do the same as \link{SicLocation} for eventually several locations +} +\examples{ +# Applying the same flow to offtakes located in nodes number 1 to 10 +locations <- lapply(seq(10), function(i) { list(Nd = i, Pr = 1, Car = "Q")}) +locations <- do.call(SicLocations, locations) +sicInputOfftakes <- SicInput(-0.5, locations = locations) +} +\seealso{ +Other SicInput: +\code{\link{SicInput}()}, +\code{\link{SicLocation}()} +} +\concept{SicInput} diff --git a/man/convert_sic_params.Rd b/man/convert_sic_params.Rd deleted file mode 100644 index a861cea558378a3203e2be5f81c945cdc0b06deb..0000000000000000000000000000000000000000 --- a/man/convert_sic_params.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_sic_params.R -\name{convert_sic_params} -\alias{convert_sic_params} -\title{Convert a list of parameters into command line arguments for Fortran SIC programs} -\usage{ -convert_sic_params(params, cfg = loadConfig()) -} -\arguments{ -\item{params}{a \link{list} of \link{character} containing the parameters to send to the fortran program with format \code{list(param=value, ...)}} - -\item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details} -} -\value{ -A \link{character} with each parameter is converted to \verb{[key param]=[value param]} and each parameter separated by a space character. -} -\description{ -This function is called by \link{sic_run_fortran} to convert list of parameters into a \link{character} command line parameters. -} -\details{ -The parameter \code{INTERF} is set to 0 (zero) by default. -} -\examples{ -\dontrun{ -cfg <- cfg_tmp_project() -convert_sic_params(list(SCE = 1, VAR = 1), cfg = cfg) -} -} diff --git a/man/extract_reach.Rd b/man/extract_reach.Rd index 7b62ec508798c4676e1518f47bf286a30f3408a2..150d650c930d34231bd907716e83d85e59ad1448 100644 --- a/man/extract_reach.Rd +++ b/man/extract_reach.Rd @@ -15,5 +15,22 @@ extract_reach(reach, x_limits) A ReachTxt object containing the selected sections. } \description{ -Select portion of a reach between two chainages +This function is used by \link{split_reach} for selecting sections of each reach. +} +\examples{ +# Create a 10km long trapezoidal uniform reach +profT <- list( + B = 2, + S = (6 - 2) / 2 / 2, + ZF = 100, + ZB = 100 + 2 +) +min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100), + upstream_bed_elevation = 10 + 2000 * 0.002, + slope = 0.002, + section_type = "T", + profile = profT) +# Extract sections between chainage 2000 m and 4000 m +sel_reach <- extract_reach(min_reach, c(2000, 4000)) + } diff --git a/man/get_result.Rd b/man/get_result.Rd index 056115768a5f2a594adaf65f96d921879316c776..2d4dd7b38fe517eb89d0efa1e49323d0e6b36282 100644 --- a/man/get_result.Rd +++ b/man/get_result.Rd @@ -15,9 +15,9 @@ get_result( \arguments{ \item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details} -\item{scenario}{\link{numeric}, the scenario to read} +\item{scenario}{\link{numeric}, the scenario to use} -\item{variant}{\link{numeric}, the variant to read} +\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)} \item{filters}{\link{character} conditions to select columns in result table, see details} @@ -32,7 +32,7 @@ Get a selection of variables from a simulation result \examples{ \dontrun{ cfg <- cfg_tmp_project() -sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) +sic_run_steady(cfg, scenario = 1) get_result(cfg, 1, filters = c("bf==4", "var=='Z'")) } } diff --git a/man/get_result_tree.Rd b/man/get_result_tree.Rd index 782f33d5c18be16e8eedec717e9158df4e7f7a47..b29d8f38199c00ba7101b701ba080520394a7f07 100644 --- a/man/get_result_tree.Rd +++ b/man/get_result_tree.Rd @@ -9,9 +9,9 @@ get_result_tree(cfg, scenario, variant = 0) \arguments{ \item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details} -\item{scenario}{\link{numeric}, the scenario to read} +\item{scenario}{\link{numeric}, the scenario to use} -\item{variant}{\link{numeric}, the variant to read} +\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)} } \value{ a \link{data.frame} with following columns: @@ -24,10 +24,15 @@ a \link{data.frame} with following columns: \description{ Get correspondence between network object and columns in result binary file } +\section{Warning}{ + +Up to now, this function only handle results at sections. +} + \examples{ \dontrun{ cfg <- cfg_tmp_project() -sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) +sic_run_steady(cfg, scenario = 1) df <- get_result_tree(cfg, 1) head(df) } diff --git a/man/merge.SicInput.Rd b/man/merge.SicInput.Rd new file mode 100644 index 0000000000000000000000000000000000000000..95cf45b834e46f80c17be075124a0d8145e3aa9e --- /dev/null +++ b/man/merge.SicInput.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sic_inputs.R +\name{merge.SicInput} +\alias{merge.SicInput} +\title{Merge SicInput objects into a list} +\usage{ +\method{merge}{SicInput}(x, y = NULL, ...) +} +\arguments{ +\item{x}{a \link{SicInput} object to merge} + +\item{y}{a \link{SicInput} object to merge} + +\item{...}{other \link{SicInput} objects to merge} +} +\value{ +A \code{SicInputs} object which is a list of \link{SicInput} +} +\description{ +Merge SicInput objects into a list +} +\details{ +The list of parameter is compliant with the \code{merge} S3 method +available in R, so this method can either be called by typing +\code{merge} or \code{merge.SicInput}. +} +\examples{ +# How to impose 5 m3/s in the upstream offtake of the model? +# Define location of the boundary condition to set +locations <- SicLocation(list(Nd = 1, Pr = 1, car = "Q")) +# Define its value +sicInputUpstream <- SicInput(5, locations = locations) + +# Opening a gate at 0.5 m +sicInputGate <- SicInput( + 0.5, + locations = SicLocations(list(Bf = 3, Sn = 2, Ouv = 1, Car = "Ouverture")) +) + +# Merging all inputs +sicInputs <- merge(sicInputUpstream, sicInputGate) + +} diff --git a/man/read_bin_result_matrix.Rd b/man/read_bin_result_matrix.Rd index c0e2bab1b2ad39de53b8c1c59b3849a4032ae552..00a0b45ade33af4ce38415fcf2c7ac6caa8e5d7a 100644 --- a/man/read_bin_result_matrix.Rd +++ b/man/read_bin_result_matrix.Rd @@ -9,9 +9,9 @@ read_bin_result_matrix(cfg, scenario, variant = 0) \arguments{ \item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details} -\item{scenario}{\link{numeric}, the scenario to read} +\item{scenario}{\link{numeric}, the scenario to use} -\item{variant}{\link{numeric}, the variant to read} +\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)} } \value{ \link{matrix} with the simulation results @@ -22,7 +22,7 @@ Read matrix of SIC simulation result file \examples{ \dontrun{ cfg <- cfg_tmp_project() -sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) +sic_run_steady(cfg, scenario = 1) m <- read_bin_result_matrix(cfg, 1) str(m) } diff --git a/man/set_initial_conditions.Rd b/man/set_initial_conditions.Rd index 9d1b02a60261256d7fb2d05755b3769384b3eb38..4caca8957fdd0aa1ff16116a2956730fdd291aca 100644 --- a/man/set_initial_conditions.Rd +++ b/man/set_initial_conditions.Rd @@ -4,18 +4,21 @@ \alias{set_initial_conditions} \title{Import initial conditions} \usage{ -set_initial_conditions(params, cfg = loadConfig()) +set_initial_conditions(iniParams, cfg = loadConfig()) } \arguments{ -\item{params}{\link{numeric}, arguments passed to Edisic for importing initial conditions. See details} +\item{iniParams}{\link{numeric}, arguments passed to Edisic for importing initial conditions. See details} \item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details} } +\value{ +Error code returned by \link{shell}. +} \description{ Import initial conditions from a scenario/variant result calculation to a new scenario/variant. } \details{ -\code{params} \link{numeric} vector of length 5. Each number correspond to: +\code{iniParams} \link{numeric} vector of length 5. Each number correspond to: \enumerate{ \item number of the scenario from which import initial conditions \item number of the variant from which import initial conditions (Use "0" for no variant) @@ -26,8 +29,23 @@ Import initial conditions from a scenario/variant result calculation to a new sc } \examples{ \dontrun{ -# Import initial conditions from the scenario #1 without variant at time 0s -# to the variant #1 in the scenario #1 -set_initial_conditions(c(1, 0, 0, 1, 1)) +# Set up the configuration model +cfg <- cfg_tmp_project() + +# Generate the mesh of the model +sic_run_mesh(cfg) + +# Run steady simulation for the scenario #1 +sic_run_steady(cfg, scenario = 1) + +# Import initial condition from scenario 1 +# to scenario 1, variant 1 for unsteady flow simulation +set_initial_conditions(c(1, 0, 0, 1, 1), cfg = cfg) + +# Run unsteady flow simulation +sic_run_unsteady(cfg, scenario = 1, variant = 1) + +# Or initiate and run the same unsteady flow simulation in one call +sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1)) } } diff --git a/man/sic_run_export.Rd b/man/sic_run_export.Rd index aea06aa93fd29e4b58d06c14abf93851960e54e8..4481d61c4aba93e0c9dca7a6fb78b630a6da34af 100644 --- a/man/sic_run_export.Rd +++ b/man/sic_run_export.Rd @@ -7,9 +7,9 @@ sic_run_export(scenario, variant = 0, params, cfg = loadConfig()) } \arguments{ -\item{scenario}{\link{numeric}, the scenario to read} +\item{scenario}{\link{numeric}, the scenario to use} -\item{variant}{\link{numeric}, the variant to read} +\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)} \item{params}{\link{list} location parameters of the result, see details.} @@ -27,7 +27,7 @@ Run SicExport and read the exported file \examples{ \dontrun{ params <- list(SCE=1) -sic_run_fortran("fluvia", params) +sic_run_steady(cfg, scenario = 1) # For exporting result in sections at time 0 sic_run_export(scenario = 1, params = list(t = 0)) } diff --git a/man/sic_run_fortran.Rd b/man/sic_run_fortran.Rd deleted file mode 100644 index 0c972bbded282694e097bedd9dc105ca2b1b6bd2..0000000000000000000000000000000000000000 --- a/man/sic_run_fortran.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/sic_run_fortran.R -\name{sic_run_fortran} -\alias{sic_run_fortran} -\title{Run Talweg, Fluvia or Sirene} -\usage{ -sic_run_fortran(prog, params = list(), cfg = loadConfig()) -} -\arguments{ -\item{prog}{\link{character}, the program to run. Should be one of "talweg"} - -\item{params}{\link{list} or \link{character}, see details} - -\item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details} -} -\value{ -Error code returned by \link{shell}. -} -\description{ -Run Talweg, Fluvia or Sirene -} -\details{ -If argument \code{params} is a \link{list}, arguments are injected in the command line by taking the items of the list with the conversion -\verb{[key]=[value]}. If argument \code{params} is a \link{character} -} -\examples{ -\dontrun{ -# Run steady simulation for the scenario #1 -cfg <- cfg_tmp_project() -params <- list(SCE=1) -sic_run_fortran("fluvia", params, cfg = cfg) -} -} diff --git a/man/sic_run_mesh.Rd b/man/sic_run_mesh.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a564a3e3d045bda4d5d1ba14b5ac3cce0cfb8138 --- /dev/null +++ b/man/sic_run_mesh.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sic_run_fortran.R +\name{sic_run_mesh} +\alias{sic_run_mesh} +\alias{sic_run_steady} +\alias{sic_run_unsteady} +\title{Run Talweg, Fluvia or Sirene for a configured project} +\usage{ +sic_run_mesh(cfg, params = list()) + +sic_run_steady(cfg, scenario, variant = 0, sicInputs = NULL, params = list()) + +sic_run_unsteady( + cfg, + scenario = iniParams[4], + variant = iniParams[5], + sicInputs = NULL, + iniParams = NULL, + params = list() +) +} +\arguments{ +\item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details} + +\item{params}{\link{list} or \link{character}, see details} + +\item{scenario}{\link{numeric}, the scenario to use} + +\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)} + +\item{sicInputs}{A \link{SicInput} object or a list of \link{SicInput} objects create by \link{merge.SicInput} +used to create a PAR file injectig inputs for the simulation} + +\item{iniParams}{5-length \link{numeric} \link{vector}, see \link{set_initial_conditions} for details} +} +\value{ +Error code returned by \link{shell}. +} +\description{ +Use \code{sic_run_mesh} to run the mesh generator, \code{sic_run_steady} for steady flow +simulation, and \code{sic_run_unsteady} for unsteady flow simulation. +} +\details{ +The argument \code{params} handles the parameters describe in +\href{https://sic.g-eau.fr/Execution-de-TALWEG-FLUVIA-et}{SIC documentation}. +If argument \code{params} is a \link{list}, arguments are injected in the command line +by taking the items of the list with the conversion \verb{[key]=[value]}. +By default, the parameter \code{INTERF=0} is added to the command line. +If argument \code{params} is a \link{character} string it is directly used as parameters of the command line. +} +\examples{ +\dontrun{ +# Set up the configuration model +cfg <- cfg_tmp_project() + +# Generate the mesh of the model +sic_run_mesh(cfg) + +# Run steady simulation for the scenario #1 +sic_run_steady(cfg, scenario = 1) + +# Import initial condition from scenario 1 +# to scenario 1, variant 1 for unsteady flow simulation +set_initial_conditions(c(1, 0, 0, 1, 1), cfg = cfg) + +# Run unsteady flow simulation +sic_run_unsteady(cfg, scenario = 1, variant = 1) + +# Or initiate and run the same unsteady flow simulation in one call +sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1)) +} +} diff --git a/man/sic_write_par.Rd b/man/sic_write_par.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c74bb11d401cbfab92951611feb4b5f7030b8c72 --- /dev/null +++ b/man/sic_write_par.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sic_inputs.R +\name{sic_write_par} +\alias{sic_write_par} +\title{Write a PAR file for SIC simulation} +\usage{ +sic_write_par(cfg, scenario, sicInputs) +} +\arguments{ +\item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details} + +\item{scenario}{\link{numeric}, the scenario to use} + +\item{sicInputs}{A \link{SicInput} object or a list of \link{SicInput} objects create by \link{merge.SicInput} +used to create a PAR file injectig inputs for the simulation} +} +\value{ +Nothing. +} +\description{ +Write inputs in a PAR file respectively to \url{https://sic.g-eau.fr/Format-of-the-par-file}. +} +\examples{ +\dontrun{ +# Setting the model configuration +cfg <- cfg_tmp_project() + +# How to impose an hydrograph at the upstream offtake of the model? +# Define the location of the upstream boundary condition to set +locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q")) +# Define its time series +sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds + v = c(5, 20, 5)), # flows + locations = locations) +# Write the parameters in the PAR file +sic_write_par(cfg, 1, sicInputs) +} +} diff --git a/man/split_reach.Rd b/man/split_reach.Rd index fe18d7eca4062dbf16e9f0e11ea5d9b5f5c1f6f6..0fde60fa7eb6fa9683baced212a9926d93d4a0bd 100644 --- a/man/split_reach.Rd +++ b/man/split_reach.Rd @@ -17,3 +17,20 @@ A \link{list} of ReachTxt objects \description{ Split a reach into a list of reaches } +\examples{ +# Create a 10km long trapezoidal uniform reach +profT <- list( + B = 2, + S = (6 - 2) / 2 / 2, + ZF = 100, + ZB = 100 + 2 +) +min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100), + upstream_bed_elevation = 10 + 2000 * 0.002, + slope = 0.002, + section_type = "T", + profile = profT) +# Split into reaches of 2000 m +reaches <- split_reach(min_reach, seq(0, 10000, 2000)) + +} diff --git a/tests/testthat/test-get_result.R b/tests/testthat/test-get_result.R index cbe939ddd9679d0a2f93ccab4a7216de527ff526..36407e676f42910ab2a7a4e03a5cf8fd895542a2 100644 --- a/tests/testthat/test-get_result.R +++ b/tests/testthat/test-get_result.R @@ -1,7 +1,7 @@ skip_on_ci() cfg <- cfg_tmp_project() -sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) +sic_run_steady(cfg, scenario = 1) test_that("get_result returns a matrix with correct colnames", { result <- get_result(cfg, 1, filters = c("bf=4", "var='Z'")) diff --git a/tests/testthat/test-set_initial_conditions.R b/tests/testthat/test-set_initial_conditions.R index 4aad0fceb8c6999ae05d4a6a1642456841ed44fe..619abafffe624dd3c42bb14e402dcbe23c560de9 100644 --- a/tests/testthat/test-set_initial_conditions.R +++ b/tests/testthat/test-set_initial_conditions.R @@ -2,8 +2,8 @@ skip_on_ci() test_that("set_initial_conditions works", { cfg <- cfg_tmp_project() - sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) + sic_run_steady(cfg, scenario = 1) set_initial_conditions(c(1, 0, 0, 1, 1), cfg = cfg) - sic_run_fortran("sirene", list(SCE = 1, VAR = 1), cfg = cfg) + sic_run_unsteady(cfg, scenario = 1, variant = 1) expect_true(file.exists(gsub("\\.xml", "_1_1.res", cfg$project$path))) }) diff --git a/tests/testthat/test-sic_run_export.R b/tests/testthat/test-sic_run_export.R index f7e8598bd5f83e7184e2f60cf1e149a75c10939f..172a58f9342c309fed721f3ff460b028950ca71b 100644 --- a/tests/testthat/test-sic_run_export.R +++ b/tests/testthat/test-sic_run_export.R @@ -3,7 +3,7 @@ skip_on_ci() cfg <- cfg_tmp_project() test_that("RunExport on Fluvia run works", { - sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) + sic_run_steady(cfg, scenario = 1) m <- sic_run_export(scenario = 1, params = list(t = 0), cfg = cfg) expect_type(m, "double") expect_equal(colnames(m)[1:3], c("Bief", "Section", "Abscisse")) diff --git a/tests/testthat/test-sic_run_fortran.R b/tests/testthat/test-sic_run_fortran.R index 5d811fef85209aee370b3708df3895acf2225dc6..f042faa96777a430ef6d7752c028e2283984a628 100644 --- a/tests/testthat/test-sic_run_fortran.R +++ b/tests/testthat/test-sic_run_fortran.R @@ -2,14 +2,20 @@ skip_on_ci() cfg <- cfg_tmp_project() -test_that("fluvia on SCE=1 should create a binary result file", { - sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg) +test_that("fluvia with scenario = 1 should create a binary result file", { + sic_run_steady(cfg, scenario = 1) expect_true(file.exists(gsub("\\.xml", "_1_0.res", cfg$project$path))) expect_true(file.exists(gsub("\\.xml", "_1_0.rci", cfg$project$path))) }) test_that("talweg should update xml project", { mtime_before <- file.mtime(cfg$project$path) - sic_run_fortran("talweg", cfg = cfg) + sic_run_mesh(cfg) expect_gt(file.mtime(cfg$project$path), mtime_before) }) + +test_that("'One call' unsteady flow simulation works", { + cfg <- cfg_tmp_project() + sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1)) + expect_true(file.exists(gsub("\\.xml", "_1_1.res", cfg$project$path))) +}) diff --git a/tests/testthat/test-sic_set_inputs.R b/tests/testthat/test-sic_set_inputs.R new file mode 100644 index 0000000000000000000000000000000000000000..731d3bc8cb8c13c6b43aea9e2b638df3dfd8a082 --- /dev/null +++ b/tests/testthat/test-sic_set_inputs.R @@ -0,0 +1,81 @@ +locations <- SicLocations(list(bf = 1, sn = 1, car = "Z"), + list(Nd = 1, Pr = 1, car = "Q")) +input <- SicInput(5, locations = locations) +dfTest <- data.frame(t = seq(0, by = 600, length.out = 11), + v = sin(0:10)) +input2 <- SicInput(dfTest, locations = SicLocation(list(Nd = 1, Car = "Z"))) + +test_that("SicLocation shoud return errors with incoherent parameters", { + expect_error(SicLocation(list(bf = 1, sn = 2)), + regexp = "Each location should have at least an item 'CAR'") + expect_error(SicLocation(list(bf = 1, nd = 2, car = "Q")), + regexp = "These items can't be together in a location", fixed = TRUE) +}) + +test_that("SicLocation should works", { + expect_s3_class(SicLocation(list(bf = 1, sn = 1, car = "Q")), "SicLocation") + expect_equal(unclass(SicLocation(list(bf = 1, sn = 1, car = "Q"))), + "BF=1\tSN=1\tCAR=Q") +}) + +test_that("SicLocations should work", { + expect_s3_class(SicLocations(list(list(bf = 1, sn = 1, car = "Q"))), "SicLocations") + expect_equal(SicLocations(list(list(bf = 1, sn = 1, car = "Q")))[1], + "BF=1\tSN=1\tCAR=Q") +}) + +test_that("SiCinput should work with fixed value", { + input <- SicInput(5, locations = locations) + expect_s3_class(input, "SicInput") + expect_equal(input$locations, locations) + expect_equal(input$data, 5) + +}) + +test_that("SiCinput should work with time in seconds", { + input <- SicInput(dfTest$t, dfTest$v, locations = locations) + expect_equal(input$data, dfTest) +}) + +test_that("SiCinput should work with time in POSIXt", { + input <- SicInput(seq(as.POSIXct("2020-01-05 00:00:00", tz = "UTC"), + by = 600, length.out = 11), + dfTest$v, + locations = locations) + expect_equal(input$data, dfTest) +}) + +test_that("SicInput should work with data.frame and matrix", { + input <- SicInput(dfTest, locations = locations) + expect_equal(input$data, dfTest) + input <- SicInput(as.matrix(dfTest), locations = locations) + expect_equal(input$data, dfTest) +}) + + +test_that("merge.SicInputs should work", { + inputs <- merge(input) + expect_length(inputs, 1) + inputs <- merge(input, input2) + expect_length(inputs, 2) + expect_equal(unclass(inputs[[2]]$locations), "ND=1\tCAR=Z") +}) + +skip_on_ci() +cfg <- cfg_tmp_project() + +test_that("sic_write_par should return errors with wrong parameters", { + expect_error(sic_write_par("toto", 1, input), regexp = "loadConfig") + expect_error(sic_write_par(cfg, "toto", input), regexp = "is.numeric") + expect_error(sic_write_par(cfg, 1, list()), regexp = "sicInputs") + expect_error(sic_write_par(cfg, c(1, 2), input), regexp = "length") +}) + +test_that("sic_write_par should works", { + sic_write_par(cfg, 1, merge(input, input2)) + file <- sic_get_par_filename(cfg, 1) + expect_true(file.exists(file)) + s <- readLines(file) + expect_equal(gsub("(\t)+$", "", s[2]), "L1\tBF=1\tSN=1\tCAR=Z") + expect_equal(gsub("(\t)+$", "",s[4]), "X1\t5") +})