Resolve "Add a `tidy_result` function"

Closes #16 (closed)

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)
 }
 

R/tidy_result.R

+#' 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)
+}

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{

man/tidy_result.Rd

+% 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
+}

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"))
+})