Add time lookup that may be used in future

pbs-assess · Mar 26, 2024 · 954a19c · 954a19c
1 parent bbadbb7
commit 954a19c
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 0 deletions.
diff --git a/R/fit.R b/R/fit.R
@@ -1375,6 +1375,7 @@ sdmTMB <- function(
   prof <- c("b_j")
   if (delta) prof <- c(prof, "b_j2")
 
+  lu <- make_year_lu(data[[time]])
   fd <- data[['__fake_data__']]
   tmp <- data[!fd,,drop=FALSE]
   tmp[['__fake_data__']] <- tmp[['__weight_sdmTMB__']] <-
@@ -1390,6 +1391,7 @@ sdmTMB <- function(
     threshold_function = thresh[[1]]$threshold_func,
     epsilon_predictor = epsilon_predictor,
     time       = time,
+    time_lu    = lu,
     family     = family,
     smoothers = sm,
     response   = y_i[!fd,,drop=FALSE],

diff --git a/R/utils.R b/R/utils.R
@@ -166,6 +166,13 @@ make_year_i <- function(x) {
   x - min(x)
 }
 
+make_year_lu <- function(x) {
+  ret <- unique(data.frame(year_i = make_year_i(x), time_from_data = x, stringsAsFactors = FALSE))
+  ret <- ret[order(ret$year_i),,drop=FALSE]
+  row.names(ret) <- NULL
+  ret
+}
+
 check_offset <- function(formula) {
   .check <- any(grepl("^offset$",
     gsub(" ", "", unlist(strsplit(as.character(formula), "\\+")))))