From c6d71988016699d7649604820c2b4f84fe7fc9ba Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@inrae.fr>
Date: Tue, 29 Mar 2022 14:24:25 +0200
Subject: [PATCH] feat: add compact_tidy_result

Refs #18
---
 NAMESPACE                        |  1 +
 R/get_result.R                   | 15 ++++++-----
 R/tidy_result.R                  | 45 +++++++++++++++++++++++++++++++-
 man/get_result.Rd                |  8 +++---
 man/tidy_result.Rd               | 33 ++++++++++++++++++++++-
 tests/testthat/test-get_result.R | 17 +++++++++---
 6 files changed, 105 insertions(+), 14 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 626b7fa..5f928e8 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 b30db78..4d28d58 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 c05f5bd..e8a333c 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 dd89494..fc8ab44 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 f9c20e0..e41d7bc 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 8c1997b..9821cb2 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))
+})
-- 
GitLab