diff --git a/DESCRIPTION b/DESCRIPTION index b37335b156e5a21d8e8f919f62281467ee9b2111..95aa6a488b5b0c73af039d0fc5b1213f488317a1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,4 +25,5 @@ Imports: magrittr, terra, tidyquery, + tidyr, xml2 diff --git a/NAMESPACE b/NAMESPACE index 43ec1e978ce1374a6e9251df08ad31d7293097ec..626b7fa94733b72fea9d38ce41b3bb2e333a0d53 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,6 +30,7 @@ export(sic_run_steady) export(sic_run_unsteady) export(sic_write_par) export(split_reach) +export(tidy_result) export(update_portion_abscissas) import(magrittr) import(utils) diff --git a/R/get_result.R b/R/get_result.R index b73a0eeb9e55e90343e3b71beb586656d3265424..b30db786a4582a72854bd3d7c9a85c92f781e869 100644 --- a/R/get_result.R +++ b/R/get_result.R @@ -2,6 +2,7 @@ #' #' @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 m [matrix] of results produced by [read_bin_result_matrix] #' #' @return [matrix] of results with a first column "t" with the simulation time @@ -26,6 +27,7 @@ get_result <- function(cfg, scenario, variant = 0, filters = c(""), + tidy = TRUE, m = read_bin_result_matrix(cfg, scenario, variant)) { df_col <- get_result_tree(cfg, scenario, variant) @@ -47,6 +49,7 @@ get_result <- function(cfg, time_prms <- sapply(attrs, function(attr) { as.numeric(xml_attr(x_res, attr)) }) + tms <- seq(from = time_prms["TpsDebut"], to = time_prms["TpsFin"], by = time_prms["TpsPas"] * time_prms["TpsSauv"]) @@ -67,9 +70,13 @@ get_result <- function(cfg, paste(cols, collapse = "|") }) - m <- cbind(tms, m) + m <- cbind(tms, m[1:length(tms), ]) colnames(m) <- c("t", column_names) + class(m) <- c("SicResult", class(m)) + if (tidy) { + return(tidy_result(m)) + } return(m) } diff --git a/R/tidy_result.R b/R/tidy_result.R new file mode 100644 index 0000000000000000000000000000000000000000..c05f5bd0d9d6b509673bc1f4a0e495232b9c9b82 --- /dev/null +++ b/R/tidy_result.R @@ -0,0 +1,32 @@ +#' Tidy a result simulation +#' +#' @param res a *SicResult* [matrix] provided by [get_result] +#' +#' @return A [data.frame] with one line per 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 +#' +#' @export +#' +#' @examples +tidy_result <- function(res) { + stopifnot(inherits(res, "SicResult")) + res <- as.data.frame(res) + df <- tidyr::gather(res, key = "key", value = "value", -"t") + keys <- strsplit(df$key, "|", fixed = TRUE) + l <- lapply(keys, function(x) { + l <- lapply(strsplit(x, ":", fixed = TRUE), + function(obj) { + df <- data.frame(x = obj[2]) + names(df) <- obj[1] + return(df) + }) + do.call(cbind, l) + }) + df_obj <- do.call(rbind, l) + df$key <- NULL + cbind(df_obj, df) +} diff --git a/man/get_result.Rd b/man/get_result.Rd index 5d02c20a0134fdf3578d47b4f884f0412ad6f5b1..dd894943efbe581b8683d1ad7401586af8f8a917 100644 --- a/man/get_result.Rd +++ b/man/get_result.Rd @@ -9,6 +9,7 @@ get_result( scenario, variant = 0, filters = c(""), + tidy = TRUE, m = read_bin_result_matrix(cfg, scenario, variant) ) } @@ -21,6 +22,8 @@ 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{m}{\link{matrix} of results produced by \link{read_bin_result_matrix}} } \value{ diff --git a/man/tidy_result.Rd b/man/tidy_result.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f9c20e0449c15837cdf93e069435249ed2687c51 --- /dev/null +++ b/man/tidy_result.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidy_result.R +\name{tidy_result} +\alias{tidy_result} +\title{Tidy a result simulation} +\usage{ +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 : +\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 +} +} +\description{ +Tidy a result simulation +} diff --git a/tests/testthat/test-get_result.R b/tests/testthat/test-get_result.R index 63b3010fbf58b136dfd86c1db83a9e9ea6ad5df2..8c1997bd5504173e7f43c1cfeb7d174085cb0c20 100644 --- a/tests/testthat/test-get_result.R +++ b/tests/testthat/test-get_result.R @@ -4,8 +4,14 @@ cfg <- cfg_tmp_project() 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'")) + result <- get_result(cfg, 1, filters = c("bf=4", "var='Z'"), tidy = FALSE) 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'")) + expect_s3_class(result, "data.frame") + expect_equal(names(result), c("bf", "sn", "var", "t", "value")) +})