options enhancements and docs

Author: stevencarlislewalker

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: macpan2
 Title: Fast and Flexible Compartmental Modelling
-Version: 3.3.0
+Version: 3.3.1
 Authors@R: c(
   person("Steve Walker", email="swalk@mcmaster.ca", role=c("cre", "aut")),
   person("Weiguang Guan", role="aut"),

NAMESPACE

@@ -86,6 +86,8 @@ S3method(mp_optimized_spec,TMBCalibrator)
 S3method(mp_optimizer_output,TMBCalibrator)
 S3method(mp_parameterization,TMBCalibrator)
 S3method(mp_parameterization,TMBSimulator)
+S3method(mp_print_obj_fn,TMBCalibrator)
+S3method(mp_print_obj_fn,TMBSimulator)
 S3method(mp_reduce,TMBModelSpec)
 S3method(mp_reference,Index)
 S3method(mp_reference,Ledger)
@@ -297,6 +299,7 @@ export(mp_positions)
 export(mp_print_after)
 export(mp_print_before)
 export(mp_print_during)
+export(mp_print_obj_fn)
 export(mp_print_spec)
 export(mp_rbf)
 export(mp_read_rds)

R/lists.R

@@ -87,20 +87,36 @@ melt_matrix = function(x, zeros_are_blank = TRUE) {
   data.frame(row = row, col = col, value = as.vector(x))
 }
 
-melt_default_matrix_list = function(x, zeros_are_blank = TRUE, simplify_as_scalars = FALSE) {
+melt_default_matrix_list = function(x
+    , zeros_are_blank = TRUE
+    , suppress_collapse_for_scalars = FALSE
+    , force_collapse_for_scalars = FALSE
+  ) {
+  if (suppress_collapse_for_scalars & force_collapse_for_scalars) stop("Developer error")
   if (length(x) == 0L) return(empty_frame("matrix", "row", "col", "value"))
   f = (x
     |> lapply(melt_matrix, zeros_are_blank)
     |> bind_rows(.id = "matrix")
   )
-  if (simplify_as_scalars) f = rm_no_info_traj_cols(f)
+  
+  ## sorry ---
+  if (force_collapse_for_scalars) f = rm_no_info_default_cols(f, collapse_default = TRUE)
+  if (!suppress_collapse_for_scalars) f = rm_no_info_default_cols(f)
 
   rownames(f) = NULL
   f
 }
 
-rm_no_info_traj_cols = function(x
+
+rm_no_info_default_cols = function(x
     , matrix_col_name = "quantity"
+    , collapse_default = getOption("macpan2_collapse_default")
+  ) {
+  rm_no_info_traj_cols(x, matrix_col_name, collapse_default)
+}
+
+rm_no_info_traj_cols = function(x
+    , matrix_col_name = "variable"
     , collapse_traj = getOption("macpan2_collapse_traj")
   ) {
 

R/mp_tmb_calibrator.R

@@ -261,8 +261,7 @@ print.TMBCalibrator = function(x, ...) {
   cat("---------------------\n")
   msg("Objective function:\n") |> cat()
   cat("---------------------\n")
-  cat(deparse1(x$simulator$tmb_model$obj_fn$formula_list()[[1L]], width.cutoff = 500L))
-  cat("\n")
+  mp_print_obj_fn(x)
   hist = x$simulator$optimization_history
   if (hist$opt_attempted()) {
     cat("\n---------------------\n")
@@ -1517,7 +1516,10 @@ TMBPar.ParArg = function(par
 
   self$random_frame = function() {
     pf = (self$spec$default[self$par_ranef]
-      |> melt_default_matrix_list(FALSE)
+      |> melt_default_matrix_list(
+          zeros_are_blank = FALSE
+        , suppress_collapse_for_scalars = TRUE
+      )
       |> rename_synonyms(mat = "matrix", default = "value")
     )
     bind_rows(pf, self$tv$tv_random_frame())
@@ -1597,7 +1599,10 @@ TMBPar.character = function(par
   }
   self$params_frame = function() {
     pf = (self$spec$default[self$par]
-      |> melt_default_matrix_list(FALSE)
+      |> melt_default_matrix_list(
+          zeros_are_blank = FALSE
+        , suppress_collapse_for_scalars = TRUE
+      )
       |> rename_synonyms(mat = "matrix", default = "value")
     )
     bind_rows(pf

R/mp_tmb_model_spec.R

@@ -405,7 +405,7 @@ defaults_printer = function(x) {
     cat("---------------------\n")
     msg("Default values:\n") |> cat()
     print(
-        melt_default_matrix_list(x$default, simplify_as_scalars = TRUE)
+        melt_default_matrix_list(x$default, force_collapse_for_scalars = TRUE)
       , row.names = FALSE
     )
     cat("---------------------\n")

R/tmb_model.R

@@ -288,7 +288,8 @@ mp_default_list = function(model, include_all = FALSE) {
 
 #' @export
 mp_default.TMBModelSpec = function(model, include_all = FALSE) {
-  melt_default_matrix_list(mp_default_list(model, include_all))
+  lst = mp_default_list(model, include_all)
+  melt_default_matrix_list(lst)
 }
 
 #' @export
@@ -303,7 +304,8 @@ mp_default_list.TMBModelSpec = function(model, include_all = FALSE) {
 
 #' @export
 mp_default.TMBSimulator = function(model, include_all = FALSE) {
-  melt_default_matrix_list(mp_default_list(model, include_all))
+  lst = mp_default_list(model, include_all)
+  melt_default_matrix_list(lst)
 }
 
 #' @export
@@ -458,6 +460,33 @@ mp_final_list.TMBSimulator = function(model) {
   mp_final(model) |> cast_default_matrix_list()
 }
 
+
+#' Print Objective Function
+#' 
+#' @param model Model object with an objective function, probably a
+#' calibrator produced using \code{\link{mp_tmb_calibrator}}.
+#' 
+#' @return Called to print the objective function for humans to read.
+#' Invisibly returns the underlying objective function object that is
+#' of limited utility.
+#' 
+#' @export
+mp_print_obj_fn = function(model) UseMethod("mp_print_obj_fn")
+
+#' @export
+mp_print_obj_fn.TMBSimulator = function(model) {
+  obj_fn = model$tmb_model$obj_fn
+  obj_formula = obj_fn$formula_list()[[1L]]
+  obj_str = deparse1(obj_formula, width.cutoff = 500L)
+  cat(obj_str)
+  cat("\n")
+  invisible(obj_fn)
+}
+
+#' @export
+mp_print_obj_fn.TMBCalibrator = function(model) mp_print_obj_fn(model$simulator)
+
+
 #' Simulate Dynamical Model Trajectories
 #' 
 #' Return simulations of the trajectory of the output
@@ -550,7 +579,7 @@ mp_trajectory.TMBSimulator = function(model, include_initial = FALSE) {
   if (length(macro) > 1L) macro = macro[[1L]]
   if (length(macro) < 1L) macro = "simulate"
   traj = model[[macro]](.phases = phases) |> reset_rownames()
-  rm_no_info_traj_cols(traj, "matrix")
+  rm_no_info_traj_cols(traj)
 }
 
 #' @export
@@ -599,7 +628,7 @@ trajectory_par_util = function(simulator
   phases = trajectory_phases_util(include_initial, include_final)
   vector = trajectory_vec_util(simulator, parameter_updates, value_column_name)
   traj = simulator$simulate(vector, .phases = phases)
-  rm_no_info_traj_cols(traj, "matrix")
+  rm_no_info_traj_cols(traj)
 }
 
 trajectory_rep_util = function(n, simulator
@@ -766,7 +795,7 @@ mp_trajectory_sd.TMBSimulator = function(model
     vars = intersect(c("value", "conf.low", "conf.high"), names(r))
     r = backtrans(r, vars, "matrix", "sd", "value")
   }
-  rm_no_info_traj_cols(r, "matrix")
+  rm_no_info_traj_cols(r)
 } 
 
 #' @export
@@ -782,7 +811,7 @@ mp_trajectory_sd.TMBCalibrator = function(model
     , back_transform
   )
   traj$time = model$time_steps_obj$internal_to_external(traj$time)
-  rm_no_info_traj_cols(traj, "matrix")
+  rm_no_info_traj_cols(traj)
 }
 
 #' @export
@@ -792,7 +821,7 @@ mp_trajectory_ensemble.TMBSimulator = function(model
   ) {
   best_pars = get_last_best_par(model$ad_fun())
   traj = model$report_ensemble(best_pars, .n = n, .probs = probs)
-  rm_no_info_traj_cols(traj, "matrix")
+  rm_no_info_traj_cols(traj)
 }
 
 #' @export
@@ -878,7 +907,7 @@ mp_trajectory_sim.TMBSimulator = function(model
     , n
     , probs = c(0.025, 0.25, 0.5, 0.75, 0.975)
   ) {
-  r = model$simulate() |> rm_no_info_traj_cols("matrix")
+  r = model$simulate() |> rm_no_info_traj_cols()
   r = r[, names(r) != "value", drop = FALSE]
   rr = (n
     |> replicate(model$simulate_values()) 

R/zzz.R

@@ -1,3 +1,11 @@
+mp_future = function() {
+  options(
+      macpan2_collapse_traj = TRUE
+    , macpan2_collapse_coef = TRUE
+    , macpan2_collapse_default = TRUE
+  )
+}
+
 #' @importFrom tools R_user_dir
 .onLoad <- function(lib, pkg) {
 
@@ -12,6 +20,7 @@
     , macpan2_verbose = FALSE
     , macpan2_collapse_traj = FALSE
     , macpan2_collapse_coef = FALSE
+    , macpan2_collapse_default = FALSE
     , macpan2_default_loss = c("clamped_poisson", "poisson", "sum_of_squares", "neg_bin")
     , macpan2_tmb_type = NULL
     , macpan2_tmb_check = TRUE