merge origin/main

Merge commit '4127c214a4857777a1e3a6554c0c6f9215ee16c5'

#Conflicts:
#	R/calculate_stats.R
#	R/run_eval_core.R

Author: mccarthy-m-g

R/calculate_bayesian_impact.R

@@ -11,9 +11,9 @@
 #'
 #' @export
 calculate_bayesian_impact <- function(
-  res
+  .res
 ) {
-  out <- res$stats_summ |>
+  out <- .res$stats_summ |>
     dplyr::filter(!.data$apriori) |>
     dplyr::select("type", "apriori", "rmse", "mape") |>
     tidyr::pivot_wider(names_from = "type", values_from = c("rmse", "mape")) |>

R/calculate_shrinkage.R

@@ -22,12 +22,12 @@
 #' @returns tibble
 #'
 #' @export
-calculate_shrinkage <- function(res) {
-  om <- get_omega_for_parameters(res$mod_obj)
-  out <- res$results |>
+calculate_shrinkage <- function(.res) {
+  om <- get_omega_for_parameters(.res$mod_obj)
+  out <- .res$results |>
     dplyr::mutate(dplyr::across(
       .cols = names(om),
-      .fns  = ~ calc_eta(.x, dplyr::cur_column(), res$mod_obj$parameters),
+      .fns  = ~ calc_eta(.x, dplyr::cur_column(), .res$mod_obj$parameters),
       .names = "eta_{.col}"
     )) |>
     dplyr::group_by(.data$`_iteration`) |>

R/calculate_stats.R

@@ -1,6 +1,6 @@
 #' Calculate basic statistics, like RMSE, MPE, MAPE for forecasted data
 #'
-#' @param res output object (`mipdeval_results`) from `run_eval()`, or
+#' @param .res output object (`mipdeval_results`) from `run_eval()`, or
 #' `data.frame` with raw results.
 #' @param rounding number of decimals to round to.
 #' @param acc_error_abs,acc_error_rel For calculating [accuracy()]: Positive number
@@ -12,21 +12,25 @@
 #'
 #' @export
 calculate_stats <- function(
-    res,
+    .res,
     rounding = 3,
     acc_error_abs = NULL,
     acc_error_rel = NULL
 ) {
-  if(inherits(res, "mipdeval_results")) {
-    res <- res$results
+  if(inherits(.res, "mipdeval_results")) {
+    .res <- .res$results
   }
   ## Check for errors during fits / predictions
-  errors <- res |>
-    dplyr::filter(is.na(pred) | (is.na(map_ipred) & !apriori) | is.na(iter_ipred))
+  errors <- dplyr::filter(
+    .res,
+    is.na(.data$pred) |
+    (is.na(.data$map_ipred) & !.data$apriori) |
+    is.na(.data$iter_ipred)
+  )
   if(nrow(errors) > 0) {
-    cli::cli_warn("Errors were encountered in {nrow(errors)} out of {nrow(res)} evaluated predictions. The problems occurred in patient(s) {unique(errors$id)}.")
+    cli::cli_warn("Errors were encountered in {nrow(errors)} out of {nrow(.res)} evaluated predictions. The problems occurred in patient(s) {unique(errors$id)}.")
   }
-  out <- res |>
+  out <- .res |>
     tidyr::pivot_longer(
       cols = c("pred", "map_ipred", "iter_ipred"), names_to = "type"
     ) |>

R/plot.R

@@ -20,12 +20,12 @@ plot.mipdeval_results <- function(x, type = "vpc", ...) {
   plot_fun(x, ...)
 }
 
-plot_vpc <- function(res, ...) {
+plot_vpc <- function(.res, ...) {
   rlang::check_installed("vpc", reason = "for VPC plotting.")
   rlang::check_dots_used()
   vpc::vpc(
-    sim = res$sim,
-    obs = dplyr::filter(res$data, .data$EVID == 0),
+    sim = .res$sim,
+    obs = dplyr::filter(.res$data, .data$EVID == 0),
     ...
   )
 }

R/run_eval_core.R

@@ -74,6 +74,24 @@ run_eval_core <- function(
         .fit_options
       )
     )
+
+    ## Data frame with predictive data
+    pred_data <- tibble::tibble(
+      id = obs_data$id,
+      t = obs_data$t,
+      dv = fit$dv,
+      ipred = fit$ipred,
+      ires = fit$ires,
+      iwres = fit$iwres,
+      pred = fit$pred,
+      res = fit$res,
+      wres = fit$wres,
+      cwres = fit$cwres,
+      ofv = fit$fit$value,
+      ss_w = ss(fit$dv, fit$ipred, weights),
+      `_iteration` = iterations[i],
+      `_grouper` = obs_data$`_grouper`
+    )
     if(inherits(fit, "error")) {
       ## create NA records for this fit
       pred_data <- tibble::tibble(
@@ -97,7 +115,12 @@ run_eval_core <- function(
         t = obs_data$t,
         dv = fit$dv,
         ipred = fit$ipred,
+        ires = fit$ires,
+        iwres = fit$iwres,
         pred = fit$pred,
+        res = fit$res,
+        wres = fit$wres,
+        cwres = fit$cwres,
         ofv = fit$fit$value,
         ss_w = ss(fit$dv, fit$ipred, weights),
         `_iteration` = iterations[i],
@@ -136,7 +159,12 @@ run_eval_core <- function(
       t = obs_data$t,
       dv = fit_map$dv,
       ipred = fit_map$ipred,
+      ires = fit_map$ires,
+      iwres = fit_map$iwres,
       pred = fit_map$pred,
+      res = fit_map$res,
+      wres = fit_map$wres,
+      cwres = fit_map$cwres,
       ofv = fit_map$fit$value,
       ss_w = ss(fit_map$dv, fit_map$ipred, w = NULL),
       `_iteration` = iterations[i],
@@ -173,9 +201,8 @@ run_eval_core <- function(
       apriori = (.data$`_iteration` == 0)
     ) |>
     dplyr::select(
-      "id", "_iteration", "_grouper", "t", "dv", "pred", "map_ipred",
-      "ofv", "ss_w",
-      "iter_ipred", "apriori",
+      "id", "_iteration", "_grouper", "t", "dv", "pred", "res", "wres", "cwres",
+      "map_ipred", "ofv", "ss_w", "iter_ipred", "ires", "iwres", "apriori",
       !!names(mod_obj$parameters)
     )
 

man/calculate_bayesian_impact.Rd

@@ -22,9 +22,9 @@ test_that("Basic run with vanco data + model works", {
   expect_s3_class(res$stats_summ, c("tbl_df", "tbl", "data.frame"))
   expect_equal(
     names(res$results),
-    c("id", "_iteration", "_grouper", "t", "dv", "pred", "map_ipred",
-      "ofv", "ss_w", "iter_ipred", "apriori", "CL", "V", "TH_CRCL",
-      "Q", "V2")
+    c("id", "_iteration", "_grouper", "t", "dv", "pred", "res", "wres", "cwres",
+      "map_ipred", "ofv", "ss_w", "iter_ipred", "ires", "iwres", "apriori", "CL",
+      "V", "TH_CRCL", "Q", "V2")
   )
   expect_equal(
     round(res$results$CL[1:5], 3),