New functions and R6 methods for output table calculations and compar…

…isons

NAMESPACE

@@ -71,6 +71,8 @@ export(get_run_param_csv)
 export(get_run_state)
 export(get_run_status)
 export(get_run_table)
+export(get_run_table_calc_csv)
+export(get_run_table_comparison_csv)
 export(get_run_table_csv)
 export(get_runs)
 export(get_scenarios)

R/OutputTables.R

@@ -6,6 +6,13 @@
 #' @param run Model run digest, run stamp or run name, modeling task run
 #'   stamp or task run name.
 #' @param name Output table name.
+#' @param calc Name of calculation. One of `"avg"`, `"sum"`, `"count"`, `"max"`,
+#'   `"min"`, `"var"`, `"sd"`, `"se"`, or `"cv"`.
+#' @param compare Comparison to calculate. One of `"diff"`, `"ratio"`, or
+#'   `"percent"`. Comparisons are for the base run relative to the variant
+#'   run (i.e., for `"diff"` it is the difference of values represented as
+#'   Variant - Base).
+#' @param variant Run digest, name, or stamp for the variant model run.
 #'
 #' @return A `list` or `tibble`.
 #'
@@ -29,4 +36,31 @@ get_run_table_csv <- function(model, run, name) {
     readr::read_csv(show_col_types = FALSE, progress = FALSE)
 }
 
+#' @rdname get_run_table
+#' @export
+get_run_table_calc_csv <- function(model, run, name, calc) {
+  rlang::arg_match(calc, c('avg', 'sum', 'count', 'max', 'min', 'var',
+                           'sd', 'se', 'cv'))
+
+  api_path <- glue::glue('api/model/{model}/run/{run}/table/{name}/calc/{calc}/csv')
+  OpenMpp$API$build_request() |>
+    httr2::req_url_path(api_path) |>
+    httr2::req_perform() |>
+    httr2::resp_body_string() |>
+    readr::read_csv(show_col_types = FALSE, progress = FALSE)
+}
+
+#' @rdname get_run_table
+#' @export
+get_run_table_comparison_csv <- function(model, run, name, compare, variant) {
+  rlang::arg_match(compare, c('diff', 'ratio', 'percent'))
+
+  api_path <- glue::glue('api/model/{model}/run/{run}/table/{name}/compare/{compare}/variant/{variant}/csv')
+  OpenMpp$API$build_request() |>
+    httr2::req_url_path(api_path) |>
+    httr2::req_perform() |>
+    httr2::resp_body_string() |>
+    readr::read_csv(show_col_types = FALSE, progress = FALSE)
+}
+
 utils::globalVariables(c('data'))

R/R6ClassModelRun.R

@@ -93,6 +93,39 @@ OpenMppModelRun <-
         rlang::abort(abort_msg)
       },
 
+      #' @description
+      #' Retrieve a table calculation.
+      #' @param name Table name.
+      #' @param calc Name of calculation. One of `"avg"`, `"sum"`, `"count"`,
+      #'   `"max"`, `"min"`, `"var"`, `"sd"`, `"se"`, or `"cv"`.
+      #' @return A `tibble`.
+      get_table_calc = function(name, calc) {
+        if (name %in% private$.tables) {
+          tbl <- get_run_table_calc_csv(self$ModelDigest, self$RunDigest, name, calc)
+          suppressWarnings(tbl$calc_value <- as.numeric(tbl$calc_value))
+          return(tbl)
+        }
+        abort_msg <- glue::glue('Table `{name}` is not available for model run.')
+        rlang::abort(abort_msg)
+      },
+
+      #' @description
+      #' Retrieve a table comparison.
+      #' @param name Table name.
+      #' @param compare Comparison to calculate. One of `"diff"`, `"ratio"`, or
+      #'   `"percent"`.
+      #' @param variant Run digest, name, or stamp for the variant model run.
+      #' @return A `tibble`.
+      get_table_comparison = function(name, compare, variant) {
+        if (name %in% private$.tables) {
+          tbl <- get_run_table_comparison_csv(self$ModelDigest, self$RunDigest, name, compare, variant)
+          suppressWarnings(tbl$calc_value <- as.numeric(tbl$calc_value))
+          return(tbl)
+        }
+        abort_msg <- glue::glue('Table `{name}` is not available for model run.')
+        rlang::abort(abort_msg)
+      },
+
       #' @description
       #' Write an output table to disk (CSV).
       #' @param name Table name.

R/R6ClassModelRunSet.R

@@ -83,6 +83,17 @@ OpenMppModelRunSet <-
           purrr::list_rbind(names_to = 'RunName')
       },
 
+      #' @description
+      #' Retrieve a table calculation.
+      #' @param name Table name.
+      #' @param calc Name of calculation. One of `"avg"`, `"sum"`, `"count"`,
+      #'   `"max"`, `"min"`, `"var"`, `"sd"`, `"se"`, or `"cv"`.
+      #' @return A `tibble`.
+      get_table_calc = function(name, calc) {
+        purrr::map(private$.runs, \(run) run$get_table_calc(name, calc)) |>
+          purrr::list_rbind(names_to = 'RunName')
+      },
+
       #' @description
       #' Write an output table to disk (CSV).
       #' @param name Table name.