Formula mapping

DESCRIPTION

@@ -53,5 +53,6 @@ Remotes:
     github::r4ss/r4ss
 Encoding: UTF-8
 LazyData: true
+LazyDataCompression: xz
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2

R/lookup_grid.R

@@ -82,7 +82,11 @@ lookup_grid <- function(x,
       latitude,
       depth,
       depth_scaled,
-      depth_scaled_squared
+      depth_scaled_squared,
+      split_mendocino,
+      split_conception,
+      split_monterey,
+      split_state
     )
 
   year_grid <- purrr::map_dfr(

R/run_sdmtmb.R

@@ -8,8 +8,14 @@
 #'   mesh that is created by {fmesher}. More knots is not always better. The
 #'   default is to use 500 knots. Future work will look at specifying a
 #'   threshold distance between points rather than number of knots.
+#' @param share_range Logical, whether or not to share the range between the
+#'   spatial and spatiotemporal fields. This defaults to FALSE, but adds extra
+#'   parameters. The default in sdmTMB is TRUE, and sharing the range may improve
+#'   estimation for data limited applications
+#' @param sdmtmb_control Optional list, in the format of [sdmTMB::sdmTMBcontrol()].
+#'   By default, this is includes 3 newton loops
 #' @param ... Optional arguments passed to [sdmTMB::sdmTMB()]. Note that users
-#'   cannot pass `anisotropy` or `sdmTMBcontrol` because both of these are set
+#'   cannot pass `anisotropy` because this are set
 #'   internal to this function, where `anisotropy = TRUE` because the coastline
 #'   of the western coastline of the U.S.A. is not perpendicular to the country
 #'   and three newton loops are specified in the control parameters.
@@ -24,6 +30,8 @@ run_sdmtmb <- function(dir_main = getwd(),
                        family,
                        formula,
                        n_knots = 500,
+                       share_range = FALSE,
+                       sdmtmb_control = sdmTMB::sdmTMBcontrol(newton_loops = 3),
                        ...) {
   # Checks
   stopifnot(inherits(family, "family"))
@@ -110,8 +118,8 @@ run_sdmtmb <- function(dir_main = getwd(),
     data = data_truncated,
     mesh = mesh,
     family = family,
-    control = sdmTMB::sdmTMBcontrol(newton_loops = 3),
-    share_range = FALSE,
+    control = sdmtmb_control,
+    share_range = share_range,
     ...
   )
   # Refit the model if the hessian is not positive definite

data-raw/configuration.R

@@ -1,30 +1,28 @@
-# TODO list
-# * Only pull data once per species and then combine the pull results with the
-#   configuration matrix again
-# * Fix how format_data returns an object without the nwfscSurvey class instead
-#   it is class(data) > [1] "tbl_df" "tbl" "data.frame"
-# * for vessel_year, might want a different level scaling things might not have
-#   to give this to grid
+# Read in the configuration file within data-raw that define what model set-up
+# to apply by species
 configuration <- tibble::as_tibble(read.csv(
   file.path("data-raw", "configuration.csv")
 ))
 
-data <- configuration %>%
+# Download the data and filter the data based upon species-specific
+# depths and latitudes in the configuration file
+data <- configuration |>
   # Row by row ... do stuff then ungroup
-  dplyr::rowwise() %>%
+  dplyr::rowwise() |>
   # Pull the data based on the function found in fxn column
   dplyr::mutate(
     data_raw = list(format_data(eval(parse(text = fxn)))),
-    data_filtered = list(data_raw %>%
+    data_filtered = list(data_raw |>
       dplyr::filter(
         depth <= min_depth, depth >= max_depth,
         latitude >= min_latitude, latitude <= max_latitude,
         year >= min_year, year <= max_year
       ))
-  ) %>%
+  ) |>
   dplyr::ungroup()
 
-best <- data %>%
+# Run the model across all species in the configuration file
+best <- data |>
   dplyr::mutate(
     # Evaluate the call in family
     family = purrr::map(family, .f = ~ eval(parse(text = .x))),
@@ -36,56 +34,18 @@ best <- data %>%
         family = family,
         anisotropy = anisotropy,
         n_knots = knots,
+        share_range = share_range,
         spatiotemporal = purrr::map2(spatiotemporal1, spatiotemporal2, list)
       ),
       .f = indexwc::run_sdmtmb
     )
   )
 
-indices <- dir(
-  file.path("canary_rockfish", "wcgbts"),
-  pattern = "sdmTMB_save",
-  recursive = TRUE,
-  full.names = TRUE
-) %>%
-  unlist() %>%
-  purrr::map_df(
-    .f = function(x) {
-      load(x)
-      if (exists("index_areas")) {
-        return(data.frame(i = x, index_areas))
-      } else {
-        return(NULL)
-      }
-    }
-  )
-gg <- ggplot2::ggplot(
-  data = indices %>%
-    dplyr::mutate(
-      dist = basename(dirname(dirname(i)))
-    ) %>%
-    dplyr::filter(area == "coastwide"),
-  ggplot2::aes(x = year, y = est, lty = dist, col = dist, group = i)
-) +
-  ggplot2::geom_line() +
-  ggplot2::theme_bw()
-ggsave(gg, filename = "indexwc_copper_rockfish.png")
-
+# TODO list
+# * Only pull data once per species and then combine the pull results with the
+#   configuration matrix again
+# * Fix how format_data returns an object without the nwfscSurvey class instead
+#   it is class(data) > [1] "tbl_df" "tbl" "data.frame"
+# * for vessel_year, might want a different level scaling things might not have
+#   to give this to grid
 
-best <- data[2, ] %>%
-  dplyr::mutate(
-    # Evaluate the call in family
-    family = purrr::map(family, .f = ~ eval(parse(text = .x))),
-    # Run the model on each row in data
-    results = purrr::pmap(
-      .l = list(
-        data = data_filtered,
-        formula = formula,
-        family = family,
-        anisotropy = anisotropy
-      ),
-      spatiotemporal = list("iid", "off"),
-      n_knots = 200,
-      .f = indexwc::run_sdmtmb
-    )
-  )