Style code and document

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FIMS
 Title: The Fisheries Integrated Modeling System
-Version: 0.3.0.0
+Version: 0.3.0.1
 Authors@R: c(
     person(c("Kelli", "F."), "Johnson", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-5149-451X")),

R/create_default_parameters.R

@@ -61,16 +61,15 @@
 #'   )
 #' }
 create_default_parameters <- function(
-  data,
-  fleets,
-  recruitment = list(
-    form = "BevertonHoltRecruitment",
-    process_distribution = c(log_devs = "DnormDistribution")
-  ),
-  # TODO: Rename EWAAgrowth to not use an acronym
-  growth = list(form = "EWAAgrowth"),
-  maturity = list(form = "LogisticMaturity")
-) {
+    data,
+    fleets,
+    recruitment = list(
+      form = "BevertonHoltRecruitment",
+      process_distribution = c(log_devs = "DnormDistribution")
+    ),
+    # TODO: Rename EWAAgrowth to not use an acronym
+    growth = list(form = "EWAAgrowth"),
+    maturity = list(form = "LogisticMaturity")) {
   # FIXME: use default values if there are no fleets info passed into the
   # function or a fleet is not present but it has data? Maybe we don't want the
   # latter because it could be that we want to drop a fleet from a model but we
@@ -256,8 +255,7 @@ create_default_DoubleLogistic <- function() {
 #' of selectivity.
 #' @noRd
 create_default_selectivity <- function(
-  form = c("LogisticSelectivity", "DoubleLogisticSelectivity")
-) {
+    form = c("LogisticSelectivity", "DoubleLogisticSelectivity")) {
   # Input checks
   form <- rlang::arg_match(form)
   # NOTE: All new forms of selectivity must be placed in the vector of default
@@ -442,10 +440,9 @@ create_default_BevertonHoltRecruitment <- function(data) {
 #' A list of default parameters for DnormDistribution.
 #' @noRd
 create_default_DnormDistribution <- function(
-  value = 0.1,
-  data,
-  input_type = c("data", "process")
-) {
+    value = 0.1,
+    data,
+    input_type = c("data", "process")) {
   # Input checks
   input_type <- rlang::arg_match(input_type)
 
@@ -486,10 +483,9 @@ create_default_DnormDistribution <- function(
 #' A list of default parameters for DlnormDistribution.
 #' @noRd
 create_default_DlnormDistribution <- function(
-  value = 0.1,
-  data,
-  input_type = c("data", "process")
-) {
+    value = 0.1,
+    data,
+    input_type = c("data", "process")) {
   # Input checks
   # TODO: Determine if value can be a vector?
   if (!is.numeric(value) || any(value <= 0, na.rm = TRUE)) {
@@ -538,10 +534,9 @@ create_default_DlnormDistribution <- function(
 #' A list with the default parameters for recruitment.
 #' @noRd
 create_default_recruitment <- function(
-  recruitment,
-  data,
-  input_type = "BevertonHoltRecruitment"
-) {
+    recruitment,
+    data,
+    input_type = "BevertonHoltRecruitment") {
   # Input checks
   if (!is.list(recruitment)) {
     cli::cli_abort(c(

R/distribution_formulas.R

@@ -54,7 +54,8 @@ check_distribution_validity <- function(args) {
     bad <- names(check_present[unlist(check_present)])
     abort_bullets <- c(
       abort_bullets,
-      "x" = "{.var {bad}} {?is/are} missing from {.var args}."
+      "x" = "{.var {bad}} {cli::qty(length(bad))} {?is/are} missing from
+             {.var args}."
     )
     # Abort early because not all of the necessary items were in args
     cli::cli_abort(abort_bullets)
@@ -107,14 +108,15 @@ check_distribution_validity <- function(args) {
     abort_bullets <- c(
       abort_bullets,
       "x" = "{.var {elements_of_sd}} need to be present in sd.",
-      "i" = "Only {.code {names(sd)}} {?is/are} present."
+      "i" = "Only {.code {names(sd)}} {cli::qty(length(sd))} {?is/are} present."
     )
   } else {
-    if (!all(sd[["value"]] > 0)) {
+    if (!all(sd[["value"]] > 0, na.rm = TRUE)) {
       abort_bullets <- c(
         abort_bullets,
         "x" = "Values passed to {.var sd} are out of bounds.",
-        "i" = "Values passed to {.var sd} {?is/are} {.code {sd[['value']]}}.",
+        "i" = "Values passed to {.var sd} {cli::qty(length(sd[['value']]))}
+               {?is/are} {.code {sd[['value']]}}.",
         "i" = "All standard deviation (sd) values need to be positive."
       )
     }
@@ -252,13 +254,12 @@ get_expected_name <- function(family, data_type) {
 #' )
 #' }
 initialize_data_distribution <- function(
-  module,
-  family,
-  sd = list(value = 1, estimated = FALSE),
-  # FIXME: Move this argument to second to match where par is in
-  # initialize_process_distribution
-  data_type = c("index", "agecomp", "lengthcomp")
-) {
+    module,
+    family,
+    sd = list(value = 1, estimated = FALSE),
+    # FIXME: Move this argument to second to match where par is in
+    # initialize_process_distribution
+    data_type = c("index", "agecomp", "lengthcomp")) {
   data_type <- rlang::arg_match(data_type)
   # FIXME: Make the available families a data object
   # Could also make the matrix of distributions available per type as a
@@ -345,12 +346,11 @@ initialize_data_distribution <- function(
 #' @keywords distribution
 #' @export
 initialize_process_distribution <- function(
-  module,
-  par,
-  family,
-  sd = list(value = 1, estimated = FALSE),
-  is_random_effect = FALSE
-) {
+    module,
+    par,
+    family,
+    sd = list(value = 1, estimated = FALSE),
+    is_random_effect = FALSE) {
   # validity check on user input
   args <- list(family = family, sd = sd)
   check_distribution_validity(args)

R/fimsfit.R

@@ -337,13 +337,12 @@ is.FIMSFits <- function(x) {
 #' @keywords fit_fims
 #' @export
 FIMSFit <- function(
-  input,
-  obj,
-  opt = list(),
-  sdreport = list(),
-  timing = c("time_total" = as.difftime(0, units = "secs")),
-  version = utils::packageVersion("FIMS")
-) {
+    input,
+    obj,
+    opt = list(),
+    sdreport = list(),
+    timing = c("time_total" = as.difftime(0, units = "secs")),
+    version = utils::packageVersion("FIMS")) {
   # What we aspire the estimate table to look like
   estimates_outline <- dplyr::tibble(
     label = character(),

R/fimsframe.R

@@ -805,12 +805,11 @@ FIMSFrame <- function(data) {
 
 # Unexported functions ----
 create_missing_data <- function(
-  data,
-  bins,
-  years,
-  column,
-  types = c("landings", "index")
-) {
+    data,
+    bins,
+    years,
+    column,
+    types = c("landings", "index")) {
   use_this_data <- data |>
     dplyr::group_by(type, name)
   out_data <- if (missing(bins)) {

R/initialize_modules.R

@@ -206,11 +206,10 @@ initialize_module <- function(parameters, data, module_name) {
 #' The initialized distribution module as an object.
 #' @noRd
 initialize_distribution <- function(
-  module_input,
-  distribution_name,
-  distribution_type = c("data", "process"),
-  linked_ids
-) {
+    module_input,
+    distribution_name,
+    distribution_type = c("data", "process"),
+    linked_ids) {
   # Input checks
   # Check if distribution_name is provided
   if (is.null(distribution_name)) {
@@ -514,12 +513,16 @@ initialize_age_comp <- function(data, fleet_name) {
   # TODO: review the AgeComp interface, do we want to add
   # `age_comp_data` as an argument?
 
-  module$age_comp_data <- age_comp_data * dplyr::filter(
-    .data = as.data.frame(data@data),
-    name == fleet_name,
-    type == "age"
-  ) |>
-    dplyr::pull(uncertainty)
+  module$age_comp_data <- age_comp_data *
+    get_data(data) |>
+      dplyr::filter(
+        name == fleet_name,
+        type == "age"
+      ) |>
+      dplyr::mutate(
+        valid_n = ifelse(value == -999, 1, uncertainty)
+      ) |>
+      dplyr::pull(valid_n)
 
   return(module)
 }
@@ -558,12 +561,16 @@ initialize_length_comp <- function(data, fleet_name) {
   # TODO: review the LengthComp interface, do we want to add
   # `age_comp_data` as an argument?
 
-  module$length_comp_data <- length_comp_data * dplyr::filter(
-    .data = as.data.frame(data@data),
-    name == fleet_name,
-    type == "length"
-  ) |>
-    dplyr::pull(uncertainty)
+  module$length_comp_data <- length_comp_data *
+    get_data(data) |>
+      dplyr::filter(
+        name == fleet_name,
+        type == "length"
+      ) |>
+      dplyr::mutate(
+        valid_n = ifelse(value == -999, 1, uncertainty)
+      ) |>
+      dplyr::pull(valid_n)
 
   return(module)
 }

tests/testthat/_snaps/fimsfit.md

@@ -3,7 +3,7 @@
     Code
       print(result)
     Message
-      i FIMS model version: 0.3.0.0
+      i FIMS model version: 0.3.0.1
       i Total run time was 10 seconds
       i Number of parameters: total=1, fixed_effects=1, and random_effects=0
       i Maximum gradient= NA