diff --git a/.covrignore b/.covrignore
index d85198cb7..4115de407 100644
--- a/.covrignore
+++ b/.covrignore
@@ -3,3 +3,5 @@
# Exclude a specific file
R/zzz.R
R/check_fims.R
+R/use-gtest-template.R
+R/use-testthat-template.R
diff --git a/NAMESPACE b/NAMESPACE
index 2adca8004..65c938ffe 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -76,6 +76,7 @@ export(m_landings)
export(m_lengthcomp)
export(m_weight_at_age)
export(multinomial)
+export(plot)
export(set_fixed)
export(set_log_throw_on_error)
export(set_random)
diff --git a/R/create_default_configurations.R b/R/create_default_configurations.R
index 8bf00ec6f..9263ac0f0 100644
--- a/R/create_default_configurations.R
+++ b/R/create_default_configurations.R
@@ -60,8 +60,8 @@ utils::globalVariables(c(
#'
#' @examples
#' # Load the example dataset and create a FIMS data frame
-#' data("data1")
-#' fims_frame <- FIMSFrame(data1)
+#' data("data_big")
+#' fims_frame <- FIMSFrame(data_big)
#'
#' # Create the default model configuration tibble
#' default_configurations <- create_default_configurations(data = fims_frame)
@@ -106,8 +106,8 @@ create_default_configurations <- function(data, model_family = c("catch_at_age")
dplyr::mutate(module_type = snake_to_pascal(type)) |>
# Set module_type to NA for weight-at-age and age-to-length-conversion
dplyr::mutate(module_type = dplyr::case_when(
- type == "weight-at-age" ~ NA_character_,
- type == "age-to-length-conversion" ~ NA_character_,
+ type == "weight_at_age" ~ NA_character_,
+ type == "age_to_length_conversion" ~ NA_character_,
TRUE ~ module_type
)) |>
# Remove any combinations where the type did not match a known module.
diff --git a/R/create_default_parameters.R b/R/create_default_parameters.R
index 258a625e2..b02ea93a4 100644
--- a/R/create_default_parameters.R
+++ b/R/create_default_parameters.R
@@ -68,8 +68,8 @@ utils::globalVariables(c(
#' @examples
#' \dontrun{
#' # Load the example dataset and create a FIMS data frame
-#' data("data1")
-#' fims_frame <- FIMSFrame(data1)
+#' data("data_big")
+#' fims_frame <- FIMSFrame(data_big)
#'
#' # Create default configurations
#' default_configurations <- create_default_configurations(fims_frame)
diff --git a/R/data1.R b/R/data_.R
similarity index 69%
rename from R/data1.R
rename to R/data_.R
index 55596fa95..bb34f9482 100644
--- a/R/data1.R
+++ b/R/data_.R
@@ -1,21 +1,21 @@
#' FIMS input data frame
#'
-#' A dataset containing information necessary to run an age-structured stock
+#' A data frame containing the information needed to run an age-structured stock
#' assessment model in FIMS. This data was generated using
#' the `ASSAMC` package written for the [model comparison project](
#' www.github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison).
-#' The source code to make this dataset is in `data-raw/data1.R` which is on
-#' Github, but won't be local because it's in the .Rbuildignore file.
+#' The source code to make this dataset is in `data-raw/data_big.R` which is on
+#' GitHub but will not be in your local installation because it is in the
+#' .Rbuildignore file.
#'
#' @format
-#' A data frame with `r NROW(data1)` observations of `r NCOL(data1)`
+#' A data frame with `r NROW(data_big)` observations of `r NCOL(data_big)`
#' variables:
#' \describe{
-#' \item{type}{The type of data the row contains. Allowed types
-#' include `age`, `length`, `index`, `landings`, `age-to-length-conversion`,
-#' and `weight-at-age` data.}
+#' \item{type}{The type of input the row contains. Allowed types include
+#' `r glue::glue_collapse(fims_input_types, sep = ", ", last = ", and ")`.}
#' \item{name}{A character string providing the name of the information source
-#' that the data was collected from, e.g., `"Trawl fishery"`.}
+#' that the input was collected from, e.g., `"Trawl fishery"`.}
#' \item{age}{An integer age. Entry can be `NA` if information pertains to
#' multiple ages, e.g., total landings rather than landings of age-4 fish.}
#' \item{length}{A numeric length. Entry can be `NA` if information doesn't
@@ -24,7 +24,7 @@
#' \item{value}{The measurement of interest.}
#' \item{unit}{A character string specifying the units of `value`. Allowed
#' units for each data type are as follows. `mt` is used for `index`,
-#' `landings`, and `weight-at-age` data. `number` or `proportion` are each
+#' `landings`, and `weight_at_age` data. `number` or `proportion` are each
#' viable units for the composition data, where the former is the preferred
#' unit of measurement.}
#' \item{uncertainty}{A real value providing a measurement of uncertainty
@@ -35,4 +35,4 @@
#' }
#' }
#' @source \url{www.github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison}
-"data1"
+"data_big"
diff --git a/R/fims_input_types.R b/R/fims_input_types.R
new file mode 100644
index 000000000..8ae22778d
--- /dev/null
+++ b/R/fims_input_types.R
@@ -0,0 +1,9 @@
+#' Vector of acceptable FIMS input types
+#'
+#' A vector of strings that define which input types are allowed in the column
+#' labeled `type` in the data slot of a FIMSFrame object. Strings are composed
+#' of words separated by underscores, e.g., `"weight_at_age"`.
+#'
+#' @format
+#' A vector of strings.
+"fims_input_types"
diff --git a/R/fimsfit.R b/R/fimsfit.R
index 019bdd5ba..527372cdb 100644
--- a/R/fimsfit.R
+++ b/R/fimsfit.R
@@ -5,11 +5,14 @@ utils::globalVariables(c(
"estimate", "estimate.x", "estimate.y",
"initial", "initial.x", "initial.y",
"derived_quantity_id",
- "distribution", "module_type", "n", "type_id", "values",
+ "distribution", "gradient",
+ "log_like_cv",
+ "module_type", "n", "type_id", "values",
"module_name.x", "module_name.y",
"module_id.x", "module_id.y",
"module_id_init",
- "module_type.x", "module_type.y"
+ "module_type.x", "module_type.y",
+ "unique_id"
))
# Developers: ----
diff --git a/R/fimsframe.R b/R/fimsframe.R
index 9e8e3b6bf..c55a35b8b 100644
--- a/R/fimsframe.R
+++ b/R/fimsframe.R
@@ -1,3 +1,9 @@
+# To remove the NOTE
+# no visible binding for global variable
+utils::globalVariables(c(
+ "name", "timing", "value"
+))
+
# Developers: ----
# This file defines the parent class FIMSFrame and its potential children. The
@@ -86,7 +92,7 @@ NULL
#' a FIMS model in a long format. The tibble will potentially have the
#' following columns depending if it fits to ages and lengths or just one of
#' them:
-#' `r glue::glue_collapse(colnames(data1), sep = ", ", last = ", and ")`.
+#' `r glue::glue_collapse(colnames(data_big), sep = ", ", last = ", and ")`.
#' @export
#' @rdname get_FIMSFrame
#' @keywords FIMSFrame
@@ -276,7 +282,7 @@ methods::setMethod(
#' data to a FIMS module because the data will have the appropriate indexing.
#'
#' @details
-#' Age-to-length-conversion data, i.e., the proportion of age "a" that are
+#' `Age_to_length_conversion` data, i.e., the proportion of age "a" that are
#' length "l", are used to convert lengths (input data) to ages (modeled) as
#' a way to fit length data without estimating growth.
#'
@@ -420,7 +426,7 @@ methods::setMethod(
function(x) {
dplyr::filter(
.data = as.data.frame(x@data),
- .data[["type"]] == "weight-at-age"
+ .data[["type"]] == "weight_at_age"
) |>
dplyr::group_by(.data[["age"]]) |>
dplyr::mutate(
@@ -456,7 +462,7 @@ methods::setMethod(
if ("length" %in% colnames(x@data)) {
dplyr::filter(
.data = as.data.frame(x@data),
- .data[["type"]] == "age-to-length-conversion",
+ .data[["type"]] == "age_to_length_conversion",
.data[["name"]] %in% fleet_name
) |>
dplyr::group_by(.data[["age"]], .data[["length"]]) |>
@@ -481,30 +487,62 @@ methods::setMethod(
# because @kellijohnson-NOAA did not quite understand how they actually work.
# methods::setMethod: plot ----
-
+#' Plot a `FIMSFrame` object
+#'
+#' Use `ggplot2::geom_point()` to plot the information stored in the data slot
+#' of the `FIMSFrame` class.
+#'
+#' @param x A `FIMSFrame` object.
+#' @param y Unused (inherited from R base).
+#' @param ... Unused (inherited from R base).
+#'
+#' @return
+#' A \pkg{ggplot2} object is returned that uses [stockplotr::theme_noaa()].
+#' There will be one panel per input type with fleet-specific information
+#' denoted using colors.
+#' @examples
+#' \dontrun{
+#' data("data_big", package = "FIMS")
+#' data_4_model <- FIMSFrame(data_big)
+#' plot(data_4_model)
+#' }
+#'
+#' @export
+#' @method plot FIMSFrame
+setGeneric("plot", function(x, y, ...)
+ standardGeneric("plot")
+)
methods::setMethod(
f = "plot",
- signature = "FIMSFrame",
+ signature = c(x = "FIMSFrame", y = "missing"),
definition = function(x, y, ...) {
+ data_for_plot <- get_data(x) |>
+ dplyr::mutate(
+ type = gsub("_", " ", type)
+ )
ggplot2::ggplot(
- data = x@data,
+ data = data_for_plot,
mapping = ggplot2::aes(
- x = .data[["timing"]],
- y = .data[["value"]],
- col = .data[["name"]]
+ x = timing,
+ y = value,
+ col = name
)
) +
# Using Set3 b/c it is the palette with the largest number of colors
# and not {nmfspalette} b/c didn't want to depend on GitHub package
ggplot2::scale_color_brewer(palette = "Set3") +
- ggplot2::facet_wrap("type", scales = "free_y") +
- ggplot2::geom_point() +
- ggplot2::scale_x_date(labels = scales::date_format("%Y-%m-%d")) +
- ggplot2::xlab("Start date (Year-Month-Day)") +
+ ggplot2::facet_wrap(
+ "type",
+ scales = "free_y",
+ labeller = ggplot2::label_wrap_gen(width = 10)
+ ) +
+ ggplot2::geom_point(alpha = 0.8) +
+ ggplot2::xlab("Timing") +
ggplot2::ylab("Value") +
ggplot2::theme(
axis.text.x = ggplot2::element_text(angle = 15)
- )
+ ) +
+ stockplotr::theme_noaa()
}
)
@@ -515,9 +553,6 @@ methods::setMethod(
signature = "FIMSFrame",
definition = function(object) {
message("tbl_df of class '", class(object), "'")
- if (length(object@data) == 0) {
- return()
- }
dat_types <- unique(object@data[[which(colnames(object@data) == "type")]])
message("with the following 'types': ", paste0(dat_types, collapse = ", "))
snames <- slotNames(object)
@@ -551,10 +586,10 @@ methods::setValidity(
errors <- c(errors, "data must have at least one row")
}
- # FIMS models currently cannot run without weight-at-age data
- weight_at_age_data <- dplyr::filter(object@data, type == "weight-at-age")
+ # FIMS models currently cannot run without weight_at_age data
+ weight_at_age_data <- dplyr::filter(object@data, type == "weight_at_age")
if (NROW(weight_at_age_data) == 0) {
- errors <- c(errors, "data must contain data of the type weight-at-age")
+ errors <- c(errors, "data must contain data of the type weight_at_age")
}
errors <- c(errors, validate_data_colnames(object@data))
@@ -570,29 +605,31 @@ methods::setValidity(
# TODO: Add checks for other slots
# Add validity check for types
- allowed_types <- c(
- "landings", "index", "age_comp", "length_comp",
- "weight-at-age", "age-to-length-conversion"
- )
present_types <- unique(object@data[["type"]])
# Issues warning if there are any unrecognized types
- unknown_types <- setdiff(present_types, allowed_types)
+ unknown_types <- sort(setdiff(present_types, fims_input_types))
if (length(unknown_types) > 0) {
cli::cli_warn(c(
- "!" = "Data contains unexpected type(s): {paste(sort(unknown_types), collapse = ', ')}",
- "i" = "Allowed types are: {paste(allowed_types, collapse = ', ')}",
- "i" = paste(
- "Model will continue to run,",
- "but check that data types are correct."
- )
+ "!" = "Data contains unexpected type(s): {unknown_types}",
+ "i" = "Allowed types are: {fims_input_types}",
+ "i" = "Model will run but check that data types are correct."
))
}
- # Return
- if (length(errors) == 0) {
- return(TRUE)
- } else {
- return(errors)
+
+ # Ensure composition data sum to 1.0 per group if units are proportions
+ for (present_type in grep("_comp", present_types, value = TRUE)) {
+ test <- object@data |>
+ dplyr::filter(type == present_type, value != -999) |>
+ dplyr::group_by(name, timing, .drop = FALSE) |>
+ dplyr::group_map(.keep = TRUE, \(.x, .y) {
+ validate_composition_data(.x)
+ })
+ if (sum(unlist(test)) > 0) {
+ cli::cli_abort(
+ "The above errors were found in your {present_type}."
+ )
+ }
}
}
)
@@ -621,6 +658,46 @@ validate_data_colnames <- function(data) {
return(errors)
}
+validate_composition_data <- function(data) {
+ composition_type <- pretty_type(unique(data[["type"]]))
+ if (all(data[["value"]] == -999)) {
+ return(0)
+ }
+ groupings <- names(data)[
+ sapply(
+ data,
+ function(x) dplyr::n_distinct(x, na.rm = FALSE) == 1 & !all(is.na(x)))
+ ]
+ grouping_message <- glue::glue("{groupings} = {data[1, groupings]}")
+ names(grouping_message) <- rep("*", length(grouping_message))
+ units <- unique(data[["unit"]])
+ errors <- vector()
+ if (length(units) != 1) {
+ errors <- c(
+ errors,
+ "x" = "There should only be one unit per grouping, units are {units}."
+ )
+ }
+ sum_of_value <- sum(data[["value"]])
+ if (all(units == "proportion") && abs(sum_of_value - 1.0) > 1e-8) {
+ errors <- c(
+ errors,
+ "x" = "The sum is equal to {sum_of_value}, not 1.0."
+ )
+ }
+ if (length(errors) > 0) {
+ cli::cli_bullets(c(
+ " " = "Group-level information for {composition_type} errors",
+ grouping_message,
+ "!" = "Errors are as follows:",
+ errors
+ ))
+ return(1)
+ } else {
+ return(0)
+ }
+}
+
# Constructors ----
# All constructors in this file are documented in 1 roxygen file via @rdname.
@@ -640,26 +717,26 @@ validate_data_colnames <- function(data) {
#' It is important that the order of the rows in the data are correct but it is
#' not expected that the user will do this. Instead, the returned data are
#' sorted using [dplyr::arrange()] before placing them in the data slot. Data
-#' are first sorted by data type, placing all weight-at-age data next to other
-#' weight-at-age data and all landings data next to landings data. Thus,
-#' age-composition data will come first because their type is "age" and "a" is
+#' are first sorted by data type, placing all `weight_at_age` data next to
+#' other `weight_at_age` data and all landings data next to landings data.
+#' Thus, `age_comp` data will come first because their type is "age" and "a" is
#' first in the alphabet. All other types will follow according to their order
#' in the alphabet.
-#' Next, within each type, data are organized by fleet. So, age-composition
+#' Next, within each type, data are organized by fleet. So, `age_comp`
#' information for fleet1 will come before survey1. Next, all data within type
#' and fleet are arranged by timing, e.g., by year. That is the end of the
-#' sorting for time series data like landings and indices.
-#' The biological data are further sorted by bin. Thus, age-composition
-#' information will be arranged as follows:
+#' sorting for time series data like landings and indices. The biological data
+#' are further sorted by bin. Thus, `age_comp` information will be arranged as
+#' follows:
#'
-#' | type | name | timing | age | value |
-#' |:---- |:--------:|:-------:|:----:|-------:|
-#' | age | fleet1 | 2022 | 1 | 0.3 |
-#' | age | fleet1 | 2022 | 2 | 0.7 |
-#' | age | fleet1 | 2023 | 1 | 0.5 |
+#' | type | name | timing | age | value |
+#' |:-------- |:--------:|:-------:|:----:|-------:|
+#' | age_comp | fleet1 | 2022 | 1 | 0.3 |
+#' | age_comp | fleet1 | 2022 | 2 | 0.7 |
+#' | age_comp | fleet1 | 2023 | 1 | 0.5 |
#'
-#' Length composition-data are sorted the same way but by length bin instead of
-#' by age bin. It becomes more complicated for the age-to-length-conversion
+#' `length_comp` data are sorted the same way but by length bin instead of
+#' by age bin. It becomes more complicated for the `age_to_length_conversion`
#' data, which are sorted by type, name, timing, age, and then length. So, a
#' full set of length, e.g., length 10, length 20, length 30, etc., is placed
#' together for a given age. After that age, another entire set of length
@@ -670,8 +747,8 @@ validate_data_colnames <- function(data) {
#'
#' @param data A `data.frame` that contains the necessary columns to construct
#' a `FIMSFrame-class` object. Currently, those columns are
-#' `r glue::glue_collapse(colnames(data1), sep = ", ", last = ", and ")`. See
-#' the data1 object in FIMS, e.g., `data(data1, package = "FIMS")`.
+#' `r glue::glue_collapse(colnames(data_big), sep = ", ", last = ", and ")`.
+#' See the `data_big` object in FIMS, e.g., `data(data_big, package = "FIMS")`.
#'
#' @return
#' An object of the S4 class `FIMSFrame` class, or one of its child classes, is
@@ -688,6 +765,11 @@ FIMSFrame <- function(data) {
paste(errors, sep = "\n", collapse = "\n")
)
}
+ if (NROW(data) == 0) {
+ cli::cli_abort(
+ "{.var data} has 0 rows of data and cannot be used to make a FIMSFrame."
+ )
+ }
# Get the earliest and latest year formatted as integers
start_year <- as.integer(floor(min(data[["timing"]], na.rm = TRUE)))
@@ -739,7 +821,7 @@ FIMSFrame <- function(data) {
bins = ages,
timings = years,
column = age,
- types = c("weight-at-age", "age_comp")
+ types = c("weight_at_age", "age_comp")
)
} else {
missing_ages <- missing_time_series[0, ]
@@ -755,13 +837,23 @@ FIMSFrame <- function(data) {
} else {
missing_lengths <- missing_time_series[0, ]
}
- if ("age-to-length-conversion" %in% formatted_data[["type"]]) {
+ if ("age_to_length_conversion" %in% formatted_data[["type"]]) {
+ if (!"age" %in% colnames(data)) {
+ cli::cli_abort(
+ "age is a required column if you have age_to_length_conversion data."
+ )
+ }
+ if (!"length" %in% colnames(data)) {
+ cli::cli_abort(
+ "length is a required column if you have age_to_length_conversion data."
+ )
+ }
# Must do this by hand because it is across two dimensions
temp_age_to_length_data <- formatted_data |>
dplyr::group_by(type, name)
missing_age_to_length <- temp_age_to_length_data |>
dplyr::group_by(type, name) |>
- dplyr::filter(type %in% "age-to-length-conversion") |>
+ dplyr::filter(type %in% "age_to_length_conversion") |>
tidyr::expand(unit, timing = years, age = ages, length = lengths) |>
dplyr::anti_join(
y = dplyr::select(
@@ -844,3 +936,8 @@ create_missing_data <- function(
) |>
dplyr::ungroup()
}
+
+pretty_type <- function(x) {
+ gsub("comp", "composition", x) |>
+ gsub(pattern = "_", replacement = " ")
+}
diff --git a/R/initialize_modules.R b/R/initialize_modules.R
index 2bc4cf064..884883f27 100644
--- a/R/initialize_modules.R
+++ b/R/initialize_modules.R
@@ -78,7 +78,7 @@ initialize_module <- function(parameters, data, module_name, fleet_name = NA_cha
data_distribution_names_for_fleet_i <- parameters |>
dplyr::filter(fleet_name == !!fleet_name & distribution_type == "Data") |>
dplyr::pull(module_type)
- if ("age-to-length-conversion" %in% fleet_types &&
+ if ("age_to_length_conversion" %in% fleet_types &&
"LengthComp" %in% data_distribution_names_for_fleet_i) {
age_to_length_conversion_value <- FIMS::m_age_to_length_conversion(data, fleet_name)
module[["age_to_length_conversion"]]$resize(length(age_to_length_conversion_value))
@@ -110,10 +110,10 @@ initialize_module <- function(parameters, data, module_name, fleet_name = NA_cha
# TODO:
# - Population interface
# - Update the Population interface to consistently use n_ages and n_years,
- # as done in the S4 data1 object.
+ # as done in the S4 data_big object.
# Update as needed.
- # - Add n_fleets to data1. Should n_fleets include both
- # fishing and survey fleets? Currently, data1@fleets equals 1.
+ # - Add n_fleets to data_big. Should n_fleets include both
+ # fishing and survey fleets? Currently, data_big@fleets equals 1.
# - Fleet
# - Reconsider exposing `log_expected_index` and
# `agecomp_proportion` to users. Their IDs are linked with
@@ -674,8 +674,8 @@ initialize_comp <- function(data,
#' @examples
#' \dontrun{
#' # Prepare data for FIMS model
-#' data("data1", package = "FIMS")
-#' data_4_model <- FIMSFrame(data1)
+#' data("data_big", package = "FIMS")
+#' data_4_model <- FIMSFrame(data_big)
#' # Instantiate modules
#' parameters_list <- data_4_model |>
#' create_default_configurations() |>
diff --git a/README.md b/README.md
index 7f924af23..492a730fd 100644
--- a/README.md
+++ b/README.md
@@ -46,9 +46,9 @@ A comprehensive list of all the tools needed to build, test, and document FIMS c
```r
library(FIMS)
# Load sample data
-data("data1")
+data("data_big")
# Prepare data for FIMS model
-data_4_model <- FIMSFrame(data1)
+data_4_model <- FIMSFrame(data_big)
# Create parameters
parameters <- data_4_model |>
diff --git a/data-raw/data1.R b/data-raw/data_big.R
similarity index 98%
rename from data-raw/data1.R
rename to data-raw/data_big.R
index f52e92491..e039c3e46 100644
--- a/data-raw/data1.R
+++ b/data-raw/data_big.R
@@ -309,13 +309,13 @@ age_data <- rbind(
)
###############################################################################
-# Weight-at-age data
+# weight_at_age data
###############################################################################
timingfishery <- data.frame(
timing = returned_om[["om_input"]][["year"]]
)
weights_fishery <- data.frame(
- type = "weight-at-age",
+ type = "weight_at_age",
name = names(returned_om[["em_input"]][["n.L"]]),
age = seq_along(returned_om[["om_input"]][["W.kg"]]),
value = returned_om[["om_input"]][["W.mt"]],
@@ -328,7 +328,7 @@ weight_at_age_data <- merge(timingfishery, weights_fishery)
# {FIMS} data
###############################################################################
# Add new column for length values and set to NA for all milestone 1 data
-data1 <- rbind(landings_data, index_data, age_data, weight_at_age_data) |>
+data_big <- rbind(landings_data, index_data, age_data, weight_at_age_data) |>
dplyr::mutate(
length = NA,
.after = "age"
@@ -341,7 +341,7 @@ observers <- c("fleet1", "survey1")
# proportions. These are identical across timing and fleets in this default
# example.
length_age_data <- data.frame(
- type = "age-to-length-conversion",
+ type = "age_to_length_conversion",
name = rep(
sort(rep(observers, length(len_bins) * length(ages))),
length(timingfishery[["timing"]])
@@ -409,9 +409,9 @@ save(
)
# Add the conversion matrix and length composition data to dataframe
-data1 <- rbind(data1, length_comp_data, length_age_data)
+data_big <- rbind(data_big, length_comp_data, length_age_data)
-usethis::use_data(data1, overwrite = TRUE)
+usethis::use_data(data_big, overwrite = TRUE)
on.exit(unlink(main_dir, recursive = TRUE), add = TRUE)
on.exit(setwd(working_dir), add = TRUE)
rm(list = ls())
diff --git a/data-raw/fims_input_types.R b/data-raw/fims_input_types.R
new file mode 100644
index 000000000..68a544d54
--- /dev/null
+++ b/data-raw/fims_input_types.R
@@ -0,0 +1,12 @@
+fims_input_types <- c(
+ "age_comp",
+ "age_to_length_conversion",
+ "index",
+ # TODO: change to singular landing
+ "landings",
+ "length_comp",
+ "weight_at_age"
+)
+
+usethis::use_data(fims_input_types, overwrite = TRUE)
+on.exit(rm(fims_input_types), add = TRUE)
diff --git a/data/data1.rda b/data/data1.rda
deleted file mode 100644
index 64cc6d23f..000000000
Binary files a/data/data1.rda and /dev/null differ
diff --git a/data/data_big.rda b/data/data_big.rda
new file mode 100644
index 000000000..008550f4a
Binary files /dev/null and b/data/data_big.rda differ
diff --git a/data/fims_input_types.rda b/data/fims_input_types.rda
new file mode 100644
index 000000000..7c6dee147
Binary files /dev/null and b/data/fims_input_types.rda differ
diff --git a/inst/WORDLIST b/inst/WORDLIST
index 6524f2079..b97e75673 100644
--- a/inst/WORDLIST
+++ b/inst/WORDLIST
@@ -780,6 +780,7 @@ kmax
knitr
knum
kv
+labeller
lastname
lcomp
ldots
diff --git a/man/FIMSFrame.Rd b/man/FIMSFrame.Rd
index 90535ee11..b5e5f1f43 100644
--- a/man/FIMSFrame.Rd
+++ b/man/FIMSFrame.Rd
@@ -9,8 +9,8 @@ FIMSFrame(data)
\arguments{
\item{data}{A \code{data.frame} that contains the necessary columns to construct
a \code{FIMSFrame-class} object. Currently, those columns are
-type, name, age, length, timing, value, unit, and uncertainty. See
-the data1 object in FIMS, e.g., \code{data(data1, package = "FIMS")}.}
+type, name, age, length, timing, value, unit, and uncertainty.
+See the \code{data_big} object in FIMS, e.g., \code{data(data_big, package = "FIMS")}.}
}
\value{
An object of the S4 class \code{FIMSFrame} class, or one of its child classes, is
@@ -34,26 +34,26 @@ data slot.
It is important that the order of the rows in the data are correct but it is
not expected that the user will do this. Instead, the returned data are
sorted using \code{\link[dplyr:arrange]{dplyr::arrange()}} before placing them in the data slot. Data
-are first sorted by data type, placing all weight-at-age data next to other
-weight-at-age data and all landings data next to landings data. Thus,
-age-composition data will come first because their type is "age" and "a" is
+are first sorted by data type, placing all \code{weight_at_age} data next to
+other \code{weight_at_age} data and all landings data next to landings data.
+Thus, \code{age_comp} data will come first because their type is "age" and "a" is
first in the alphabet. All other types will follow according to their order
in the alphabet.
-Next, within each type, data are organized by fleet. So, age-composition
+Next, within each type, data are organized by fleet. So, \code{age_comp}
information for fleet1 will come before survey1. Next, all data within type
and fleet are arranged by timing, e.g., by year. That is the end of the
-sorting for time series data like landings and indices.
-The biological data are further sorted by bin. Thus, age-composition
-information will be arranged as follows:\tabular{lcccr}{
+sorting for time series data like landings and indices. The biological data
+are further sorted by bin. Thus, \code{age_comp} information will be arranged as
+follows:\tabular{lcccr}{
type \tab name \tab timing \tab age \tab value \cr
- age \tab fleet1 \tab 2022 \tab 1 \tab 0.3 \cr
- age \tab fleet1 \tab 2022 \tab 2 \tab 0.7 \cr
- age \tab fleet1 \tab 2023 \tab 1 \tab 0.5 \cr
+ age_comp \tab fleet1 \tab 2022 \tab 1 \tab 0.3 \cr
+ age_comp \tab fleet1 \tab 2022 \tab 2 \tab 0.7 \cr
+ age_comp \tab fleet1 \tab 2023 \tab 1 \tab 0.5 \cr
}
-Length composition-data are sorted the same way but by length bin instead of
-by age bin. It becomes more complicated for the age-to-length-conversion
+\code{length_comp} data are sorted the same way but by length bin instead of
+by age bin. It becomes more complicated for the \code{age_to_length_conversion}
data, which are sorted by type, name, timing, age, and then length. So, a
full set of length, e.g., length 10, length 20, length 30, etc., is placed
together for a given age. After that age, another entire set of length
diff --git a/man/create_default_configurations.Rd b/man/create_default_configurations.Rd
index 3045420d1..8553872da 100644
--- a/man/create_default_configurations.Rd
+++ b/man/create_default_configurations.Rd
@@ -61,8 +61,8 @@ building a complete FIMS model configuration.
}
\examples{
# Load the example dataset and create a FIMS data frame
-data("data1")
-fims_frame <- FIMSFrame(data1)
+data("data_big")
+fims_frame <- FIMSFrame(data_big)
# Create the default model configuration tibble
default_configurations <- create_default_configurations(data = fims_frame)
diff --git a/man/create_default_parameters.Rd b/man/create_default_parameters.Rd
index d196c07f2..867cd3e2e 100644
--- a/man/create_default_parameters.Rd
+++ b/man/create_default_parameters.Rd
@@ -63,8 +63,8 @@ as \code{"Logistic"}, it generates initial values for \code{"inflection_point"}
\examples{
\dontrun{
# Load the example dataset and create a FIMS data frame
-data("data1")
-fims_frame <- FIMSFrame(data1)
+data("data_big")
+fims_frame <- FIMSFrame(data_big)
# Create default configurations
default_configurations <- create_default_configurations(fims_frame)
diff --git a/man/data1.Rd b/man/data_big.Rd
similarity index 71%
rename from man/data1.Rd
rename to man/data_big.Rd
index 3ac8d3cff..cd012f04f 100644
--- a/man/data1.Rd
+++ b/man/data_big.Rd
@@ -1,18 +1,17 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data1.R
+% Please edit documentation in R/data_.R
\docType{data}
-\name{data1}
-\alias{data1}
+\name{data_big}
+\alias{data_big}
\title{FIMS input data frame}
\format{
A data frame with 19080 observations of 8
variables:
\describe{
-\item{type}{The type of data the row contains. Allowed types
-include \code{age}, \code{length}, \code{index}, \code{landings}, \code{age-to-length-conversion},
-and \code{weight-at-age} data.}
+\item{type}{The type of input the row contains. Allowed types include
+age_comp, age_to_length_conversion, index, landings, length_comp, and weight_at_age.}
\item{name}{A character string providing the name of the information source
-that the data was collected from, e.g., \code{"Trawl fishery"}.}
+that the input was collected from, e.g., \code{"Trawl fishery"}.}
\item{age}{An integer age. Entry can be \code{NA} if information pertains to
multiple ages, e.g., total landings rather than landings of age-4 fish.}
\item{length}{A numeric length. Entry can be \code{NA} if information doesn't
@@ -21,7 +20,7 @@ pertain to length.}
\item{value}{The measurement of interest.}
\item{unit}{A character string specifying the units of \code{value}. Allowed
units for each data type are as follows. \code{mt} is used for \code{index},
-\code{landings}, and \code{weight-at-age} data. \code{number} or \code{proportion} are each
+\code{landings}, and \code{weight_at_age} data. \code{number} or \code{proportion} are each
viable units for the composition data, where the former is the preferred
unit of measurement.}
\item{uncertainty}{A real value providing a measurement of uncertainty
@@ -36,13 +35,14 @@ be your input sample size.
\url{www.github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison}
}
\usage{
-data1
+data_big
}
\description{
-A dataset containing information necessary to run an age-structured stock
+A data frame containing the information needed to run an age-structured stock
assessment model in FIMS. This data was generated using
the \code{ASSAMC} package written for the \href{www.github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison}{model comparison project}.
-The source code to make this dataset is in \code{data-raw/data1.R} which is on
-Github, but won't be local because it's in the .Rbuildignore file.
+The source code to make this dataset is in \code{data-raw/data_big.R} which is on
+GitHub but will not be in your local installation because it is in the
+.Rbuildignore file.
}
\keyword{datasets}
diff --git a/man/fims_input_types.Rd b/man/fims_input_types.Rd
new file mode 100644
index 000000000..07480d325
--- /dev/null
+++ b/man/fims_input_types.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/fims_input_types.R
+\docType{data}
+\name{fims_input_types}
+\alias{fims_input_types}
+\title{Vector of acceptable FIMS input types}
+\format{
+A vector of strings.
+}
+\usage{
+fims_input_types
+}
+\description{
+A vector of strings that define which input types are allowed in the column
+labeled \code{type} in the data slot of a FIMSFrame object. Strings are composed
+of words separated by underscores, e.g., \code{"weight_at_age"}.
+}
+\keyword{datasets}
diff --git a/man/initialize_fims.Rd b/man/initialize_fims.Rd
index 476de0d0b..046a36502 100644
--- a/man/initialize_fims.Rd
+++ b/man/initialize_fims.Rd
@@ -45,8 +45,8 @@ at least one fleet and population module.
\examples{
\dontrun{
# Prepare data for FIMS model
-data("data1", package = "FIMS")
-data_4_model <- FIMSFrame(data1)
+data("data_big", package = "FIMS")
+data_4_model <- FIMSFrame(data_big)
# Instantiate modules
parameters_list <- data_4_model |>
create_default_configurations() |>
diff --git a/man/m_.Rd b/man/m_.Rd
index 7af407ddb..093651362 100644
--- a/man/m_.Rd
+++ b/man/m_.Rd
@@ -78,7 +78,7 @@ e.g., weight_at_age. These accessor functions are the preferred way to pass
data to a FIMS module because the data will have the appropriate indexing.
}
\details{
-Age-to-length-conversion data, i.e., the proportion of age "a" that are
+\code{Age_to_length_conversion} data, i.e., the proportion of age "a" that are
length "l", are used to convert lengths (input data) to ages (modeled) as
a way to fit length data without estimating growth.
}
diff --git a/man/plot.Rd b/man/plot.Rd
new file mode 100644
index 000000000..5b8c9567f
--- /dev/null
+++ b/man/plot.Rd
@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/fimsframe.R
+\name{plot}
+\alias{plot}
+\title{Plot a \code{FIMSFrame} object}
+\usage{
+plot(x, y, ...)
+}
+\arguments{
+\item{x}{A \code{FIMSFrame} object.}
+
+\item{y}{Unused (inherited from R base).}
+
+\item{...}{Unused (inherited from R base).}
+}
+\value{
+A \pkg{ggplot2} object is returned that uses \code{\link[stockplotr:theme_noaa]{stockplotr::theme_noaa()}}.
+There will be one panel per input type with fleet-specific information
+denoted using colors.
+}
+\description{
+Use \code{ggplot2::geom_point()} to plot the information stored in the data slot
+of the \code{FIMSFrame} class.
+}
+\examples{
+\dontrun{
+data("data_big", package = "FIMS")
+data_4_model <- FIMSFrame(data_big)
+plot(data_4_model)
+}
+
+}
diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml
index 952e14dce..8b2f4c047 100644
--- a/pkgdown/_pkgdown.yml
+++ b/pkgdown/_pkgdown.yml
@@ -14,7 +14,7 @@ authors:
template:
bootstrap: 5
includes:
- before_title:
+ before_title:
in_header: |
@@ -47,7 +47,9 @@ reference:
desc: >
Example dataset used in FIMS demonstrations and examples.
contents:
- - data1
+ - data_big
+ - fims_input_types
+ - plot
- title: Run FIMS
desc: Primary functions used when setting up or running a FIMS model.
diff --git a/pkgdown/assets/fims-cheatsheet-thumb.png b/pkgdown/assets/fims-cheatsheet-thumb.png
index a4e339c6f..cdbe14604 100644
Binary files a/pkgdown/assets/fims-cheatsheet-thumb.png and b/pkgdown/assets/fims-cheatsheet-thumb.png differ
diff --git a/pkgdown/assets/fims-cheatsheet.pdf b/pkgdown/assets/fims-cheatsheet.pdf
index a293227fd..a60aa5532 100644
Binary files a/pkgdown/assets/fims-cheatsheet.pdf and b/pkgdown/assets/fims-cheatsheet.pdf differ
diff --git a/tests/README.md b/tests/README.md
index 1ef42dca6..295cfb63a 100644
--- a/tests/README.md
+++ b/tests/README.md
@@ -23,7 +23,7 @@ Prepare the test data in the new file or in a separate file if you plan on reusi
prepare_test_data()
}
```
-- Use pre-existing integration data, e.g., `tests/testthat/fixtures/integration_test_data_components.RData` and `tests/testthat/fixtures/integration_test_data.RData`, by loading them within the `setup` section, e.g., `load(testthat::test_path("fixtures", "integration_test_data.RData"))` or within `prepare_test_data()`, where these data objects can be updated by running `R/data1.R`.
+- Use pre-existing integration data, e.g., `tests/testthat/fixtures/integration_test_data_components.RData` and `tests/testthat/fixtures/integration_test_data.RData`, by loading them within the `setup` section, e.g., `load(testthat::test_path("fixtures", "integration_test_data.RData"))` or within `prepare_test_data()`, where these data objects can be updated by running `R/data_big.R`.
### :pencil: Edit the code in the new test file
diff --git a/tests/testthat/fixtures/integration_test_data.RData b/tests/testthat/fixtures/integration_test_data.RData
index 37dfbf475..ae79f3024 100644
Binary files a/tests/testthat/fixtures/integration_test_data.RData and b/tests/testthat/fixtures/integration_test_data.RData differ
diff --git a/tests/testthat/fixtures/integration_test_data_components.RData b/tests/testthat/fixtures/integration_test_data_components.RData
index 1e1da3a1f..f2250d7bf 100644
Binary files a/tests/testthat/fixtures/integration_test_data_components.RData and b/tests/testthat/fixtures/integration_test_data_components.RData differ
diff --git a/tests/testthat/helper-integration-tests-setup-function.R b/tests/testthat/helper-integration-tests-setup-function.R
index a724bc5ce..851415e0e 100644
--- a/tests/testthat/helper-integration-tests-setup-function.R
+++ b/tests/testthat/helper-integration-tests-setup-function.R
@@ -542,7 +542,7 @@ setup_and_run_FIMS_with_wrappers <- function(iter_id,
# Clear any previous FIMS settings
clear()
- data <- FIMS::FIMSFrame(data1)
+ data <- FIMS::FIMSFrame(data_big)
if (tibble::is_tibble(modified_parameters)) {
parameters <- modified_parameters
} else {
diff --git a/tests/testthat/helper-integration-tests-setup-run.R b/tests/testthat/helper-integration-tests-setup-run.R
index 53cf7bf6c..bda6e28bd 100644
--- a/tests/testthat/helper-integration-tests-setup-run.R
+++ b/tests/testthat/helper-integration-tests-setup-run.R
@@ -6,7 +6,7 @@
#' This function prepares the input data for integration tests by generating
#' datasets containing only age composition, only length composition data, or
#' data with missing values. The integration_test_data_components.RData is
-#' generated after running the script R/data1.R.
+#' generated after running the script R/data_big.R.
#'
#' @return None. The function saves the generated datasets as RDS files in the
#' specified directory.
@@ -19,7 +19,7 @@ prepare_test_data <- function() {
# The section generates datasets containing only age composition, only length
# composition data, or data with missing values.
# The integration_test_data_components.RData is generated after running the
- # script R/data1.R.
+ # script R/data_big.R.
# Load required integration test data components
load(testthat::test_path("fixtures", "integration_test_data_components.RData"))
@@ -69,7 +69,7 @@ prepare_test_data <- function() {
data_length_comp_na <- data_length_comp_raw |>
dplyr::filter(
!(name == "survey1" &
- type %in% c("index", "length_comp", "age-to-length-conversion") &
+ type %in% c("index", "length_comp", "age_to_length_conversion") &
timing == na_index
)
) |>
@@ -95,7 +95,7 @@ prepare_test_data <- function() {
) |>
dplyr::filter(
!(name == "fleet1" &
- type %in% c("length_comp", "age-to-length-conversion") &
+ type %in% c("length_comp", "age_to_length_conversion") &
timing == length_na_index
)
) |>
@@ -122,7 +122,7 @@ prepare_test_data <- function() {
om_output <- om_output_list[[iter_id]]
em_input <- em_input_list[[iter_id]]
- data_age_length_comp <- FIMSFrame(data1)
+ data_age_length_comp <- FIMSFrame(data_big)
default_parameters <- create_default_configurations(
data = data_age_length_comp
) |>
diff --git a/tests/testthat/test-create_default_configurations.R b/tests/testthat/test-create_default_configurations.R
index 8419430ea..8a4bad810 100644
--- a/tests/testthat/test-create_default_configurations.R
+++ b/tests/testthat/test-create_default_configurations.R
@@ -10,8 +10,8 @@
# create_default_configurations ----
## Setup ----
# Load or prepare any necessary data for testing
-data("data1")
-data_age_length <- FIMSFrame(data1)
+data("data_big")
+data_age_length <- FIMSFrame(data_big)
## IO correctness ----
test_that("`create_default_configurations()` works with correct inputs", {
diff --git a/tests/testthat/test-create_default_parameters.R b/tests/testthat/test-create_default_parameters.R
index 33e0a4ad8..774aa3aa9 100644
--- a/tests/testthat/test-create_default_parameters.R
+++ b/tests/testthat/test-create_default_parameters.R
@@ -9,7 +9,7 @@
# create_default_* ----
## Setup ----
-data <- FIMS::FIMSFrame(data1)
+data <- FIMS::FIMSFrame(data_big)
default_configurations <- create_default_configurations(data)
diff --git a/tests/testthat/test-fimsframe.R b/tests/testthat/test-fimsframe.R
index a1b265b51..9c698318c 100644
--- a/tests/testthat/test-fimsframe.R
+++ b/tests/testthat/test-fimsframe.R
@@ -9,7 +9,7 @@
# fims_frame ----
## Setup ----
-fims_frame <- FIMS::FIMSFrame(data1)
+fims_frame <- FIMS::FIMSFrame(data_big)
# A helper function that creates a figure from code
save_png <- function(code, width = 1000, height = 1000) {
@@ -88,11 +88,96 @@ test_that("`fims_frame()` works with the correct inputs", {
#' @description Test that the `show()` method works as expected on a `FIMSFrame` object.
expect_output(suppressMessages(show(fims_frame)))
#' @description Test that 'FIMSFrame()' succeeds cleanly with valid inputs.
- expect_no_error(FIMS::FIMSFrame(data1))
+ expect_no_error(FIMS::FIMSFrame(data_big))
+ #' @description Test that `is.FIMSFrame()` is `TRUE` when passed a FIMSFrame object.
+ expect_true(is.FIMSFrame(fims_frame))
+ #' @description Test that `is.FIMSFrame()` is FALSE when passed a data frame.
+ expect_false(is.FIMSFrame(data_big))
+
+ #' @description Test that `pretty_type()`, an unexported function, returns space separated values with "comp" expanded to "composition".
+ expect_equal(
+ pretty_type(x = c("age_comp", "weight_at_age")),
+ c("age composition", "weight at age")
+ )
})
## Edge handling ----
-# No edge cases to test.
+test_that("`FIMSFrame()` returns correct outputs for edge cases", {
+ #' @description Test that `get_data()` retrieves the data slot as a data frame when passed a data frame rather than a FIMSFrame object.
+ expect_s3_class(get_data(data_big), "data.frame")
+
+ #' @description Test that `get_fleets()` retrieves the fleet names as a character vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(get_fleets(data_big), ptype = character())
+
+ #' @description Test that `get_n_years()` retrieves the number of years as an integer when passed a data frame rather than a FIMSFrame object.
+ expect_type(get_n_years(data_big), "integer")
+
+ #' @description Test that `get_start_year()` retrieves the start year as a single value when passed a data frame rather than a FIMSFrame object.
+ expect_length(get_n_years(data_big), 1)
+
+ #' @description Test that `get_start_year()` retrieves the start year as an integer when passed a data frame rather than a FIMSFrame object.
+ expect_type(get_start_year(data_big), "integer")
+
+ #' @description Test that `get_start_year()` retrieves the start year as a single value when passed a data frame rather than a FIMSFrame object.
+ expect_length(get_start_year(data_big), 1)
+
+ #' @description Test that `get_end_year()` retrieves the end year as an integer when passed a data frame rather than a FIMSFrame object.
+ expect_type(get_end_year(data_big), "integer")
+
+ #' @description Test that `get_end_year()` retrieves the end year as a single value when passed a data frame rather than a FIMSFrame object.
+ expect_length(get_end_year(data_big), 1)
+
+ fleet_names <- get_fleets(data_big)
+ #' @description Test that `get_fleets()` retrieves the fleet names as a character vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(fleet_names, ptype = character())
+
+ #' @description Test that `get_ages()` retrieves the ages as an integer vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(get_ages(data_big), ptype = integer())
+
+ #' @description Test that `get_n_ages()` retrieves the number of ages as an integer when passed a data frame rather than a FIMSFrame object.
+ expect_type(get_n_ages(data_big), "integer")
+ #' @description Test that `get_n_ages()` retrieves the number of ages as a single value when passed a data frame rather than a FIMSFrame object.
+ expect_length(get_n_ages(data_big), 1)
+
+ #' @description Test that `m_landings()` retrieves landings data as a numeric vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(m_landings(data_big, fleet_names), ptype = numeric())
+
+ #' @description Test that `m_index()` retrieves index data as a numeric vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(m_index(data_big, fleet_names), ptype = numeric())
+
+ #' @description Test that `m_agecomp()` retrieves age composition data as a numeric vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(m_agecomp(data_big, fleet_names), ptype = numeric())
+
+ #' @description Test that `m_lengthcomp()` retrieves length composition data as a numeric vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(m_lengthcomp(data_big, fleet_names), ptype = numeric())
+
+ #' @description Test that `m_weight_at_age()` retrieves weight-at-age data as a numeric vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(m_weight_at_age(data_big), ptype = numeric())
+
+ #' @description Test that `m_age_to_length_conversion()` retrieves age-to-length conversion data as a numeric vector when passed a data frame rather than a FIMSFrame object.
+ expect_vector(
+ m_age_to_length_conversion(data_big, fleet_names),
+ ptype = numeric()
+ )
+
+ #' @description Test that `FIMSFrame()` works without an ages column.
+ expect_silent(FIMSFrame(
+ dplyr::filter(
+ data_big,
+ !type %in% c("length", "age_to_length_conversion")
+ ) |>
+ dplyr::select(-age)
+ ))
+
+ #' @description Test that `FIMSFrame()` works without a length column.
+ expect_silent(FIMSFrame(
+ dplyr::filter(
+ data_big,
+ !type %in% c("length", "age_to_length_conversion")
+ ) |>
+ dplyr::select(-length)
+ ))
+})
## Error handling ----
test_that("`FIMSFrame()` returns correct error messages", {
@@ -102,6 +187,16 @@ test_that("`FIMSFrame()` returns correct error messages", {
#' @description Validators for `FIMSFrame` work as expected.
expect_error(FIMSFrame(bad_input))
+ #' @description Test that `FIMSFrame()` returns an error when there is no data in the FIMSFrame object.
+ expect_error(FIMSFrame(data_big[0, ]))
+
+ #' @description Test that `FIMSFrame` validators pick up on a missing age in age-composition data.
+ expect_error(
+ FIMSFrame(
+ dplyr::filter(data_big, age != 3)
+ )
+ )
+
#' @description Test that the `m_landings()` returns an error when a fleet is not supplied.
expect_error(
m_landings(fims_frame),
@@ -137,11 +232,27 @@ test_that("`FIMSFrame()` returns correct error messages", {
m_weight_at_age(fims_frame, fleet_names),
regexp = "unused argument"
)
+
+ #' @description Test that `FIMSFrame()` returns an error when there are no age data.
+ expect_error(
+ FIMSFrame(dplyr::mutate(data_big, age = NA_integer_)),
+ regexp = "they are all `NA`"
+ )
+ #' @description Test that `FIMSFrame()` returns an error when the age column is not present but `age_to_length_conversion` is present in type.
+ expect_error(
+ FIMSFrame(dplyr::select(data_big, -age)),
+ "is a required column"
+ )
+ #' @description Test that `FIMSFrame()` returns an error when the length column is not present but `age_to_length_conversion` is present in type.
+ expect_error(
+ FIMSFrame(dplyr::select(data_big, -length)),
+ "is a required column"
+ )
})
# m_* ----
## Setup ----
-fims_frame <- FIMS::FIMSFrame(data1)
+fims_frame <- FIMS::FIMSFrame(data_big)
n_years <- get_n_years(fims_frame)
n_ages <- get_n_ages(fims_frame)
@@ -239,7 +350,7 @@ test_that("`get_n_fleets()` works with correct inputs", {
## Check that FIMSFrame warns on unexpected data types
test_that("FIMSFrame() warns on unexpected data types", {
bad <- dplyr::mutate(
- data1,
+ data_big,
type = ifelse(type == "index", "indexes", type) # Introduce an unsupported type
)
#' @description Test that 'FIMSFrame()' warns on unexpected data types.
diff --git a/tests/testthat/test-initialize_modules.R b/tests/testthat/test-initialize_modules.R
index 0a8a3fb72..f1585317b 100644
--- a/tests/testthat/test-initialize_modules.R
+++ b/tests/testthat/test-initialize_modules.R
@@ -10,7 +10,7 @@
# test_initialize_modules ----
## Setup ----
-data <- FIMS::FIMSFrame(data1)
+data <- FIMS::FIMSFrame(data_big)
default_parameters <- create_default_configurations(data = data) |>
create_default_parameters(data = data) |>
diff --git a/tests/testthat/test-integration-caa-mle-wrappers.R b/tests/testthat/test-integration-caa-mle-wrappers.R
index 40d5b772f..39846c853 100644
--- a/tests/testthat/test-integration-caa-mle-wrappers.R
+++ b/tests/testthat/test-integration-caa-mle-wrappers.R
@@ -201,7 +201,7 @@ test_that("catch-at-age model (estimation MLE with wrappers) works with mixed es
## Error handling ----
test_that("catch-at-age model (estimation MLE with wrappers) returns an error when there are no estimated parameters for optimization", {
# Load data
- data_age_length_comp <- FIMSFrame(data1)
+ data_age_length_comp <- FIMSFrame(data_big)
# Load pre-configured parameters
parameters <- readRDS(
testthat::test_path("fixtures", "parameters_model_comparison_project.RDS")
diff --git a/tests/testthat/test-integration-fims-estimation-random-effects-with-wrappers.R b/tests/testthat/test-integration-fims-estimation-random-effects-with-wrappers.R
index bac31a708..af63cc094 100644
--- a/tests/testthat/test-integration-fims-estimation-random-effects-with-wrappers.R
+++ b/tests/testthat/test-integration-fims-estimation-random-effects-with-wrappers.R
@@ -339,7 +339,7 @@ test_that("estimation test of fims using wrapper functions", {
test_that("estimation test with recruitment re on logr", {
#' @description Test that the estimation run of FIMS with recruitment random effects on log(R0) matches the operating model values.
skip("Skipping test for deterministic FIMS with recruitment random effects until wrappers are fixed")
- fims_data <- FIMS::FIMSFrame(data1)
+ fims_data <- FIMS::FIMSFrame(data_big)
# Clear any previous FIMS settings
clear()
diff --git a/tests/testthat/test-integration-fleet-log-obs-error-input.R b/tests/testthat/test-integration-fleet-log-obs-error-input.R
index 197d21694..0bafcf094 100644
--- a/tests/testthat/test-integration-fleet-log-obs-error-input.R
+++ b/tests/testthat/test-integration-fleet-log-obs-error-input.R
@@ -13,9 +13,9 @@
load(test_path("fixtures", "integration_test_data.RData"))
# Load sample data
-data("data1")
+data("data_big")
# Prepare data for FIMS model
-data_4_model <- FIMSFrame(data1)
+data_4_model <- FIMSFrame(data_big)
# Create parameters
default_parameters <- data_4_model |>
diff --git a/tests/testthat/test-rcpp-data.R b/tests/testthat/test-rcpp-data.R
index 72983c588..b86a9577a 100644
--- a/tests/testthat/test-rcpp-data.R
+++ b/tests/testthat/test-rcpp-data.R
@@ -9,7 +9,7 @@
# rcpp data ----
## Setup ----
-fims_frame <- FIMS::FIMSFrame(data1)
+fims_frame <- FIMS::FIMSFrame(data_big)
n_years <- get_n_years(fims_frame)
n_ages <- get_n_ages(fims_frame)
diff --git a/tests/testthat/test-rcpp-ewaa.R b/tests/testthat/test-rcpp-ewaa.R
index 20529c972..743b8dac5 100644
--- a/tests/testthat/test-rcpp-ewaa.R
+++ b/tests/testthat/test-rcpp-ewaa.R
@@ -10,7 +10,7 @@
# EWAAGrowth ----
## Setup ----
# Prepare data
-fims_frame <- FIMS::FIMSFrame(data1)
+fims_frame <- FIMS::FIMSFrame(data_big)
# Ensure that the fims_frame object is removed after tests are completed
on.exit(rm(fims_frame), add = TRUE)
diff --git a/tests/testthat/test-slow-parallel-caa-mle-wrappers.R b/tests/testthat/test-slow-parallel-caa-mle-wrappers.R
index 907402965..65ffcfdfc 100644
--- a/tests/testthat/test-slow-parallel-caa-mle-wrappers.R
+++ b/tests/testthat/test-slow-parallel-caa-mle-wrappers.R
@@ -43,7 +43,7 @@ sim_num <- 4
# Create the initial FIMS data and default parameter structures,
# then map through the simulation iterations to apply iteration-specific
# values from the operating model.
-data_age_length_comp <- FIMSFrame(data1)
+data_age_length_comp <- FIMSFrame(data_big)
default_parameters <- create_default_configurations(
data = data_age_length_comp
) |>
diff --git a/vignettes/fims-demo-projections.Rmd b/vignettes/fims-demo-projections.Rmd
index b2145616f..628507a36 100644
--- a/vignettes/fims-demo-projections.Rmd
+++ b/vignettes/fims-demo-projections.Rmd
@@ -43,9 +43,9 @@ The code below uses the built-in data within FIMS and sets up a simple catch-at-
```{r data-without-projections}
# Bring the package data into your environment
-data("data1")
+data("data_big")
# Prepare the package data for being used in a FIMS model
-data_4_model <- FIMSFrame(data1)
+data_4_model <- FIMSFrame(data_big)
# Create default model configurations based on the data
default_configurations <- create_default_configurations(data = data_4_model)
@@ -66,15 +66,15 @@ In the future, we will integrate more of the process below coded below into wrap
```{r projection-data}
# Add a single row of landings to the original data for the maximum year you
# want to project to
-data1_with_extra_year <- dplyr::add_row(
- data1,
+data_big_with_extra_year <- dplyr::add_row(
+ data_big,
type = "landings",
timing = get_end_year(data_4_model) + years_of_projection,
name = "fleet1",
value = -999,
unit = "mt"
)
-data_4_projections <- data1_with_extra_year |>
+data_4_projections <- data_big_with_extra_year |>
# Make a FIMSFrame object out of this data frame with the extra row to add all
# of the other missing years for each data type
FIMSFrame() |>
diff --git a/vignettes/fims-demo.Rmd b/vignettes/fims-demo.Rmd
index 735164041..320fe3b0c 100644
--- a/vignettes/fims-demo.Rmd
+++ b/vignettes/fims-demo.Rmd
@@ -53,15 +53,15 @@ clear()
## Data
-Data for a FIMS model must be stored in a single data frame using a long format, e.g., `data("data1", package = "FIMS")`. The design is similar to running a linear model where you pass a single data frame to `lm()`.
+Data for a FIMS model must be stored in a single data frame using a long format, e.g., `data("data_big", package = "FIMS")`. The design is similar to running a linear model where you pass a single data frame to `lm()`.
The long format does lead to some information being duplicated. For example, the units are listed for every row rather than stored in a single location for each data type. But, the long format facilitates using tidy functions to manipulate the data. And, a single function, i.e., `FIMSFrame()`, is all that is needed to prepare the data to be used in a FIMS model.
-### `data1`
+### `data_big`
-A sample data frame for a catch-at-age model with both ages and lengths is stored in the package as `data1`. This data set is based on data that was used in [Li et al.](https://www.doi.org/10.7755/FB.119.2-3.5) for the Model Comparison Project ([github site](https://github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison)). The length data have since been added [data-raw/data1.R](https://github.com/NOAA-FIMS/FIMS/blob/main/data-raw/data1.R) based on an age-length conversion matrix.
+A sample data frame for a catch-at-age model with both ages and lengths is stored in the package as `data_big`. This data set is based on data that was used in [Li et al.](https://www.doi.org/10.7755/FB.119.2-3.5) for the Model Comparison Project ([github site](https://github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison)). The length data have since been added [data-raw/data_big.R](https://github.com/NOAA-FIMS/FIMS/blob/main/data-raw/data_big.R) based on an age-length conversion matrix.
-To see how this example data frame was created, see the R script here [R/data1.R](https://github.com/NOAA-FIMS/FIMS/blob/main/R/data1.R). To find out more about the columns that are present use `?data1`.
+To see how this example data frame was created, see the R script here [R/data_big.R](https://github.com/NOAA-FIMS/FIMS/blob/main/R/data_big.R). To find out more about the columns that are present use `?data_big`.
### `FIMSFrame()`
@@ -69,9 +69,9 @@ Once you have a long data frame, you can pass it to `FIMSFrame()` to prepare you
```{r FIMSFrame}
# Bring the package data into your environment
-data("data1")
+data("data_big")
# Prepare the package data for being used in a FIMS model
-data_4_model <- FIMSFrame(data1)
+data_4_model <- FIMSFrame(data_big)
```
There are helper functions for working with objects that have the `FIMSFrame` class, e.g., `get_data()`, `get_n_years()`, `get_*()`. Additionally, there are helper functions for pulling data out of the class in the format needed for a module, i.e., a vector, but these `m_*()` functions. These `m_*()` functions will not be explored in this vignette because they are largely meant to be used by power users to manually set up FIMS modules.
@@ -94,6 +94,18 @@ The data contains the following fleets:
- A single fishery fleet with age- and length-composition, weight-at-age, and landings data
- A single survey with age- and length-composition and index data
+You can use the base R function `plot(data_4_model)` to see the data types (e.g., landings, length composition, age composition, etc.) in the `data_4_model` object by fleet.
+
+```{r FIMSFrame-plot}
+#| warning: false
+#| message: false
+#| fig.alt: >
+#| Landings are increasing over time and the index is decreasing over time.
+#| fig.cap: >
+#| FIMS input values by type (panels) and fleet (colors).
+plot(data_4_model)
+```
+
## Configurations
### `create_default_configurations()`
diff --git a/vignettes/fims-logging.Rmd b/vignettes/fims-logging.Rmd
index a8d3acd18..ec0ac8b17 100644
--- a/vignettes/fims-logging.Rmd
+++ b/vignettes/fims-logging.Rmd
@@ -17,7 +17,7 @@ clear()
```{r set-up-model, include=FALSE}
# use FIMS data frame
-data_4_model <- FIMSFrame(data1)
+data_4_model <- FIMSFrame(data_big)
default_parameters <- create_default_configurations(data = data_4_model) |>
create_default_parameters(data = data_4_model)
diff --git a/vignettes/fims-path-maturity.Rmd b/vignettes/fims-path-maturity.Rmd
index 3f59a7ffb..a630e823b 100644
--- a/vignettes/fims-path-maturity.Rmd
+++ b/vignettes/fims-path-maturity.Rmd
@@ -58,11 +58,11 @@ After loading FIMS and the default data set that comes with FIMS, a maturity mod
library(FIMS)
# Load a built-in data set from the FIMS package
-data("data1")
+data("data_big")
# Convert the data into a FIMSFrame object, which is an S4 class.
# See ?FIMSFrame for more information.
-fims_frame <- FIMSFrame(data1)
+fims_frame <- FIMSFrame(data_big)
# Create default maturity parameters using internal function
default_parameters <- create_default_configurations(fims_frame) |>