diff --git a/NAMESPACE b/NAMESPACE index 626b7fa94733b72fea9d38ce41b3bb2e333a0d53..5f928e8473294a7d0c987c6d10dffd83327f610f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ export(SicInput) export(SicLocation) export(SicLocations) export(cfg_tmp_project) +export(compact_tidy_result) export(create_section_txt) export(create_uniform_reach_txt) export(dem_to_reach) diff --git a/R/get_result.R b/R/get_result.R index b30db786a4582a72854bd3d7c9a85c92f781e869..4d28d58b63ff138268881b05070b56d2a504fa10 100644 --- a/R/get_result.R +++ b/R/get_result.R @@ -2,10 +2,10 @@ #' #' @inheritParams sic_run_mesh #' @param filters [character] conditions to select columns in result table, see details -#' @param tidy [logical], if TRUE the result is returned after being processed by [tidy_result] +#' @param fun_format [function] to format the result (See [tidy_result]) #' @param m [matrix] of results produced by [read_bin_result_matrix] #' -#' @return [matrix] of results with a first column "t" with the simulation time +#' @return If `format =NULL`, it's a [matrix] of results with a first column "t" with the simulation time #' in seconds followed by columns selected by `filters`. #' #' Column names are a concatenation of nested SIC model elements separated by @@ -14,6 +14,8 @@ #' For example, water elevation in the first section of the first reach is: #' "bf:1|sn:1|var:Z". #' +#' If `format = tidy_result` or `format = compact_tidy_result`, see the documentation of [tidy_result]. +#' #' @export #' @import magrittr #' @@ -27,7 +29,7 @@ get_result <- function(cfg, scenario, variant = 0, filters = c(""), - tidy = TRUE, + fun_format = NULL, m = read_bin_result_matrix(cfg, scenario, variant)) { df_col <- get_result_tree(cfg, scenario, variant) @@ -70,12 +72,13 @@ get_result <- function(cfg, paste(cols, collapse = "|") }) - m <- cbind(tms, m[1:length(tms), ]) + m <- cbind(tms, m[1:length(tms), , drop = FALSE]) + colnames(m) <- c("t", column_names) class(m) <- c("SicResult", class(m)) - if (tidy) { - return(tidy_result(m)) + if (!is.null(fun_format)) { + return(fun_format(m)) } return(m) } diff --git a/R/tidy_result.R b/R/tidy_result.R index c05f5bd0d9d6b509673bc1f4a0e495232b9c9b82..e8a333c88f3ba63d4d0bb86998c754d93beec6e6 100644 --- a/R/tidy_result.R +++ b/R/tidy_result.R @@ -2,16 +2,41 @@ #' #' @param res a *SicResult* [matrix] provided by [get_result] #' -#' @return A [data.frame] with one line per saved simulation result time step : +#' @return `tidy_result` returns a [data.frame] with one line by variable and by saved simulation result time step : #' #' - one column per object type of the result (example: "bf" and "sn" for a section or "nd" and "pr" for an offtake) #' - one column "var" for the definition of the result variable #' - one column "t" for the simulation time of the result variable #' - one columne "value" for the value of the result variable #' +#' `compact_tidy_result` returns a [data.frame] with one line by variable : +#' +#' - one column per object type of the result (example: "bf" and "sn" for a section or "nd" and "pr" for an offtake) +#' - one column "var" for the definition of the result variable +#' - one column "values" containing a [data.frame] with a column `value` +#' +#' The data.frame contains an attribute "t" with the time of the saved simulation time steps in seconds. +#' #' @export #' #' @examples +#' \dontrun{ +#' cfg <- cfg_tmp_project() +#' # Run unsteady flow simulation (flood over one day) +#' sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1)) +#' # Get water elevation in reach #2, section #2 +#' m <- get_result(cfg, 1, 1, +#' filters = c("bf=2", "sn=2", "var='Z'")) +#' res <- tidy_result(m) +#' plot(res$t, res$value) +#' # Formatting can be called directly through argument +#' # `fun_format` of `get_result` function +#' res <- get_result(cfg, 1, 1, +#' filters = c("bf=2", "sn=2", "var='Z'"), +#' fun_format = compact_tidy_result)) +#' # Plot result in first object against simulation time +#' plot(attr(res, "t"), res$values[1][[1]]) +#' } tidy_result <- function(res) { stopifnot(inherits(res, "SicResult")) res <- as.data.frame(res) @@ -30,3 +55,21 @@ tidy_result <- function(res) { df$key <- NULL cbind(df_obj, df) } + +#' @rdname tidy_result +#' @export +compact_tidy_result <- function(res) { + res1 <- res[1, , drop = FALSE] + class(res1) <- class(res) + df <- tidy_result(res1) + cols <- seq_len(nrow(df)) + names(cols) <- colnames(res)[-1] + l <- lapply(cols, function(i) { + res[, 1 + i] + }) + df$values <- l + attr(df, "t") <- res[, 1] + df$t <- NULL + df$value <- NULL + df +} diff --git a/man/get_result.Rd b/man/get_result.Rd index dd894943efbe581b8683d1ad7401586af8f8a917..fc8ab442397de265b0181b177a6c44a20ec7b6c4 100644 --- a/man/get_result.Rd +++ b/man/get_result.Rd @@ -9,7 +9,7 @@ get_result( scenario, variant = 0, filters = c(""), - tidy = TRUE, + fun_format = NULL, m = read_bin_result_matrix(cfg, scenario, variant) ) } @@ -22,12 +22,12 @@ get_result( \item{filters}{\link{character} conditions to select columns in result table, see details} -\item{tidy}{\link{logical}, if TRUE the result is returned after being processed by \link{tidy_result}} +\item{fun_format}{\link{function} to format the result (See \link{tidy_result})} \item{m}{\link{matrix} of results produced by \link{read_bin_result_matrix}} } \value{ -\link{matrix} of results with a first column "t" with the simulation time +If \code{format =NULL}, it's a \link{matrix} of results with a first column "t" with the simulation time in seconds followed by columns selected by \code{filters}. Column names are a concatenation of nested SIC model elements separated by @@ -35,6 +35,8 @@ the character "|" and numbered after the character ":". The variable is represented by the item "var". For example, water elevation in the first section of the first reach is: "bf:1|sn:1|var:Z". + +If \code{format = tidy_result} or \code{format = compact_tidy_result}, see the documentation of \link{tidy_result}. } \description{ Get a selection of variables from a simulation result diff --git a/man/tidy_result.Rd b/man/tidy_result.Rd index f9c20e0449c15837cdf93e069435249ed2687c51..e41d7bc66c0aab34de8d553ca1993a06662f2ca3 100644 --- a/man/tidy_result.Rd +++ b/man/tidy_result.Rd @@ -2,22 +2,53 @@ % Please edit documentation in R/tidy_result.R \name{tidy_result} \alias{tidy_result} +\alias{compact_tidy_result} \title{Tidy a result simulation} \usage{ tidy_result(res) + +compact_tidy_result(res) } \arguments{ \item{res}{a \emph{SicResult} \link{matrix} provided by \link{get_result}} } \value{ -A \link{data.frame} with one line per saved simulation result time step : +\code{tidy_result} returns a \link{data.frame} with one line by variable and by saved simulation result time step : \itemize{ \item one column per object type of the result (example: "bf" and "sn" for a section or "nd" and "pr" for an offtake) \item one column "var" for the definition of the result variable \item one column "t" for the simulation time of the result variable \item one columne "value" for the value of the result variable } + +\code{compact_tidy_result} returns a \link{data.frame} with one line by variable : +\itemize{ +\item one column per object type of the result (example: "bf" and "sn" for a section or "nd" and "pr" for an offtake) +\item one column "var" for the definition of the result variable +\item one column "values" containing a \link{data.frame} with a column \code{value} +} + +The data.frame contains an attribute "t" with the time of the saved simulation time steps in seconds. } \description{ Tidy a result simulation } +\examples{ +\dontrun{ +cfg <- cfg_tmp_project() +# Run unsteady flow simulation (flood over one day) +sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1)) +# Get water elevation in reach #2, section #2 +m <- get_result(cfg, 1, 1, + filters = c("bf=2", "sn=2", "var='Z'")) +res <- tidy_result(m) +plot(res$t, res$value) +# Formatting can be called directly through argument +# `fun_format` of `get_result` function +res <- get_result(cfg, 1, 1, + filters = c("bf=2", "sn=2", "var='Z'"), + fun_format = compact_tidy_result)) +# Plot result in first object against simulation time +plot(attr(res, "t"), res$values[1][[1]]) +} +} diff --git a/tests/testthat/test-get_result.R b/tests/testthat/test-get_result.R index 8c1997bd5504173e7f43c1cfeb7d174085cb0c20..9821cb2c574a4e0297c7e4d7838f30a668297f6b 100644 --- a/tests/testthat/test-get_result.R +++ b/tests/testthat/test-get_result.R @@ -1,17 +1,28 @@ skip_on_ci() cfg <- cfg_tmp_project() -sic_run_steady(cfg, scenario = 1) +sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1)) test_that("get_result returns a matrix with correct colnames", { - result <- get_result(cfg, 1, filters = c("bf=4", "var='Z'"), tidy = FALSE) + result <- get_result(cfg, 1, filters = c("bf=4", "var='Z'")) expect_true(is.matrix(result)) expect_type(result, "double") expect_equal(colnames(result), c("t", sprintf("bf:4|sn:%d|var:Z", 1:4))) }) test_that("get_result with tidy return a tidy result", { - result <- get_result(cfg, 1, filters = c("bf=4", "var='Z'")) + result <- get_result(cfg, 1, + filters = c("bf=4", "var='Z'"), + fun_format = tidy_result) expect_s3_class(result, "data.frame") expect_equal(names(result), c("bf", "sn", "var", "t", "value")) }) + +test_that("get_result with tidy return a tidy result", { + result <- get_result(cfg, 1, 1, + filters = c("bf=4", "var='Z'"), + fun_format = compact_tidy_result) + expect_s3_class(result, "data.frame") + expect_equal(names(result), c("bf", "sn", "var", "values")) + expect_equal(attr(result, "t"), seq(0, 86400, by = 60)) +})