time scales and variation

NAMESPACE

@@ -8,7 +8,6 @@ S3method(StructuredVector,StructuredVector)
 S3method(StructuredVector,data.frame)
 S3method(StructuredVector,numeric)
 S3method(TMBTV,RBFArg)
-S3method(TMBTV,TVArg)
 S3method(TMBTV,character)
 S3method(TMBTraj,"function")
 S3method(TMBTraj,TrajArg)
@@ -38,6 +37,8 @@ S3method(length,StructuredVector)
 S3method(macpan2::TMBPar,ParArg)
 S3method(macpan2::TMBPar,character)
 S3method(macpan2::TMBPar,list)
+S3method(macpan2::TMBTV,TVArg)
+S3method(macpan2::TMBTV,list)
 S3method(mp_default,TMBCalibrator)
 S3method(mp_default,TMBModelSpec)
 S3method(mp_default,TMBSimulator)
@@ -109,6 +110,8 @@ S3method(mp_tmb_fixef_cov,TMBCalibrator)
 S3method(mp_tmb_fixef_cov,TMBSimulator)
 S3method(mp_tmb_objective,TMBCalibrator)
 S3method(mp_tmb_objective,TMBSimulator)
+S3method(mp_tmb_profile,TMBCalibrator)
+S3method(mp_tmb_profile,TMBSimulator)
 S3method(mp_tmb_test,TMBModelSpec)
 S3method(mp_tmbstan_coef,TMBCalibrator)
 S3method(mp_tmbstan_coef,TMBSimulator)
@@ -295,6 +298,7 @@ export(mp_print_before)
 export(mp_print_during)
 export(mp_print_spec)
 export(mp_rbf)
+export(mp_rbf_exper)
 export(mp_read_rds)
 export(mp_reduce)
 export(mp_reference)
@@ -334,6 +338,7 @@ export(mp_tmb_insert_trans)
 export(mp_tmb_library)
 export(mp_tmb_model_spec)
 export(mp_tmb_objective)
+export(mp_tmb_profile)
 export(mp_tmb_update)
 export(mp_tmbstan_coef)
 export(mp_traj)

R/calibrator_arg_constructors.R

@@ -11,7 +11,10 @@
 #' effects.
 #' @concept create-model-calibrator-args
 #' @export
-mp_par = function(params, random) {
+mp_par = function(
+      params = empty_named_list()
+    , random = empty_named_list()
+  ) {
   arg = list()
   arg$params = params
   arg$random = random
@@ -22,9 +25,17 @@ mp_par = function(params, random) {
 
 #' @param parameters List of time-variation specifications for parameters.
 #' @noRd
-mp_tv = function(parameters) {
+mp_tv = function(
+      params = empty_named_list()
+    , random = empty_named_list()
+    , known = empty_named_list()
+    , linear = empty_named_list()
+  ) {
   arg = list()
-  arg$parameters = parameters
+  arg$params = params
+  arg$random = random
+  arg$known = known
+  arg$linear = linear
   structure(arg, class = "TVArg")
 }
 
@@ -74,6 +85,16 @@ mp_rbf = function(tv, dimension, initial_weights, seed, prior_sd = 1, fit_prior_
   structure(arg, class = "RBFArg")
 }
 
+#' @export
+mp_rbf_exper = function(dimension
+    , initial_weights
+    , seed
+    , prior_sd = 1
+    , fit_prior_sd = TRUE
+    , sparse_tol = 1e-2) {
+  mp_rbf("", dimension, initial_weights, seed, prior_sd, fit_prior_sd, sparse_tol)
+}
+
 
 mp_piecewise = function(tv, data) {
   arg = list()

R/distributions.R

@@ -335,6 +335,7 @@ DistrList = function(distr_list = list(), model_spec = mp_tmb_model_spec()) {
     nms = names(obj[[mth]]())
     for (i in seq_along(nms)) self$distr_list[[nms[i]]]$update_variable_name(tv_nms[i])
   }
+
 
   # section 2: distributional parameters that need to be added as 
   ## _new_ defaults to model spec to be updated by calibration machinery
@@ -674,9 +675,14 @@ mp_normal = function(location = mp_distr_param_null("location")
 #' @description * Log-Normal Distribution - `mp_log_normal`
 #' @name distribution
 #' @export
-mp_log_normal = function(location = mp_distr_param_null("location")
-                       , sd
-                       , trans_distr_param = list(location = mp_identity, sd = mp_identity)) {
+mp_log_normal = function(
+       location = mp_distr_param_null("location")
+     , sd
+     , trans_distr_param = list(
+          location = mp_identity
+        , sd = mp_identity
+      )
+  ) {
   self = DistrSpec(
       distr_param_objs = nlist(location, sd)
       # identity transformations because distributional parameters are already
@@ -689,13 +695,15 @@ mp_log_normal = function(location = mp_distr_param_null("location")
             , par
             , self$distr_param_objs$location$expr_ref()
             , self$distr_param_objs$sd$expr_ref()
+            #, par
     )
   }
   self$likelihood = \(obs, sim) {
     sprintf("-sum(dnorm(log(%s), log(%s), %s))"
             , obs
             , sim
             , self$distr_param_objs$sd$expr_ref()
+            #, obs
     )
   }
   self$check_variable = function(variable) {
@@ -723,17 +731,19 @@ mp_logit_normal = function(location = mp_distr_param_null("location")
   )
 
   self$prior = \(par) {
-    sprintf("-sum(dnorm(log(%s) - log(1 - %s), %s, %s))"
+    sprintf("-sum(dnorm(log(%s) - log(1 - %s), %s, %s) / (%s * (1 - %s)))"
             , par, par
             , self$distr_param_objs$location$expr_ref()
             , self$distr_param_objs$sd$expr_ref()
+            , par, par
     )
   }
   self$likelihood = \(obs, sim) {
-    sprintf("-sum(dnorm(log(%s) - log(1 - %s), log(%s) - log(1 - %s), %s))"
+    sprintf("-sum(dnorm(log(%s) - log(1 - %s), log(%s) - log(1 - %s), %s) / (%s * (1 - %s)))"
             , obs, obs
             , sim, sim
             , self$distr_param_objs$sd$expr_ref()
+            , obs, obs
     )
   }
   self$check_variable = function(variable) {
@@ -930,7 +940,7 @@ to_distr_param.character = function(x) mp_nofit(x)
 #' @noRd
 mp_poisson2 = function(location) {
   self = DistrSpec()
-  self$distr_params = \() list()
+  self$distr_params = \() empty_named_list()
   self$expr_char = \(x, location) sprintf("-sum(dpois(%s, %s))", x, location)
   return_object(self, "Poisson")
 }

R/frame_utils.R

@@ -74,9 +74,6 @@ bind_rows <- function(..., .id = NULL) {
       y
     })
   }
-
-  # some_rows = function(x) isTRUE(nrow(x) != 0L)
-  # lsts <- Filter()
   nms <- unique(unlist(lapply(lsts, names)))
   lsts <- lapply(
     lsts,

R/lists.R

@@ -157,3 +157,4 @@ simplify_row_col_ids = function(data_frame) {
   if (identical(uc, "0")) data_frame$col = character(nrow(data_frame))
   return(data_frame)
 }
+

R/mp_cal_time.R

@@ -30,31 +30,44 @@ mp_sim_bounds = function(sim_start, sim_end, time_scale = "steps", time_column =
   self$sim_end = sim_end
   self$time_scale = time_scale
   self$time_column = time_column
-  self$extend = function(steps_to_extend) {
-    new_obj = mp_sim_offset(
-        self$sim_start_offset
-      , self$sim_end_offset + steps_to_extend
-      , self$time_scale
-      , self$time_column
-    )
-    return(new_obj)
-  }
+# <<<<<<< HEAD
   self$cal_time_steps = function(data, original_coercer = force) {
     column = data[[self$time_column]]
-    check_valid_time_scales(self$time_scale)
-    constr = get_time_constructor(self$time_scale)
-    if (length(column) == 0L) {
-      dat_start = self$sim_start
-      dat_end = self$sim_end
-    } else {
-      dat_start = min(column)
-      dat_end = max(column)
-    }
+    dat_start = min(column)
+    dat_end = max(column)
+    ## TODO: check type consistency
+    constr = switch(self$time_scale
+      , steps = CalTimeStepsInt
+      , daily = CalTimeStepsDaily
+    )
+# =======
+#   self$extend = function(steps_to_extend) {
+#     new_obj = mp_sim_offset(
+#         self$sim_start_offset
+#       , self$sim_end_offset + steps_to_extend
+#       , self$time_scale
+#       , self$time_column
+#     )
+#     return(new_obj)
+#   }
+#   self$cal_time_steps = function(data, original_coercer = force) {
+#     column = data[[self$time_column]]
+#     check_valid_time_scales(self$time_scale)
+#     constr = get_time_constructor(self$time_scale)
+#     if (length(column) == 0L) {
+#       dat_start = self$sim_start
+#       dat_end = self$sim_end
+#     } else {
+#       dat_start = min(column)
+#       dat_end = max(column)
+#     }
+# >>>>>>> main
     constr(self$sim_start, self$sim_end, dat_start, dat_end, original_coercer)
   }
   return_object(self, "SimBounds")
 }
 
+
 #' Simulation Offsets
 #' 
 #' Offset the starting and ending times of the simulation, from the
@@ -102,6 +115,11 @@ mp_sim_offset = function(sim_start_offset, sim_end_offset, time_scale = "steps",
     }
     sim_start = dat_start - self$sim_start_offset
     sim_end = dat_end + self$sim_end_offset
+    ## TODO: check type consistency
+    constr = switch(self$time_scale
+      , steps = CalTimeStepsInt
+      , daily = CalTimeStepsDaily
+    )
     constr(sim_start, sim_end, dat_start, dat_end, original_coercer)
   }
   return_object(self, "SimOffset")