diff --git a/.github/workflows/build-doxygen.yml b/.github/workflows/build-doxygen.yml index 1522f3f1c..7da888230 100644 --- a/.github/workflows/build-doxygen.yml +++ b/.github/workflows/build-doxygen.yml @@ -21,7 +21,7 @@ jobs: steps: - name: Get repository - uses: actions/checkout@v4 + uses: actions/checkout@v5 - name: Installing build dependencies run: | diff --git a/.github/workflows/call-allcontributors.yml b/.github/workflows/call-allcontributors.yml index bfcb2c1aa..1cc1d16d2 100644 --- a/.github/workflows/call-allcontributors.yml +++ b/.github/workflows/call-allcontributors.yml @@ -19,7 +19,7 @@ jobs: pull-requests: write steps: - name: Checkout repository - uses: actions/checkout@v4 + uses: actions/checkout@v5 - name: Setup R uses: r-lib/actions/setup-r@v2 diff --git a/.github/workflows/get-gtest-codecov.yml b/.github/workflows/get-gtest-codecov.yml index 2ae853afd..102395be1 100644 --- a/.github/workflows/get-gtest-codecov.yml +++ b/.github/workflows/get-gtest-codecov.yml @@ -19,7 +19,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v5 - name: Install Ninja run: sudo apt-get install ninja-build - uses: r-lib/actions/setup-r@v2 diff --git a/.github/workflows/greetings.yml b/.github/workflows/greetings.yml index 3f05adcae..399bb22b3 100644 --- a/.github/workflows/greetings.yml +++ b/.github/workflows/greetings.yml @@ -2,6 +2,10 @@ name: Greetings on: [pull_request_target, issues] +permissions: + issues: write + pull-requests: write + jobs: greeting: runs-on: ubuntu-latest @@ -9,7 +13,7 @@ jobs: issues: write pull-requests: write steps: - - uses: actions/first-interaction@v1 + - uses: actions/first-interaction@v3 with: repo-token: ${{ secrets.GITHUB_TOKEN }} issue-message: > diff --git a/.github/workflows/run-clang-format.yml b/.github/workflows/run-clang-format.yml index a09276910..2f6e89b65 100644 --- a/.github/workflows/run-clang-format.yml +++ b/.github/workflows/run-clang-format.yml @@ -27,7 +27,7 @@ jobs: # Format hpp and cpp files under inst/include, src/, and test/gtest # We use Google style to format code. steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v5 - uses: DoozyX/clang-format-lint-action@v0.20 with: source: './inst/include ./src ./tests/gtest' diff --git a/.github/workflows/run-clang-tidy.yml b/.github/workflows/run-clang-tidy.yml index 52fb09eed..7d741534f 100644 --- a/.github/workflows/run-clang-tidy.yml +++ b/.github/workflows/run-clang-tidy.yml @@ -27,7 +27,7 @@ jobs: strategy: fail-fast: false steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v5 - name: install clang-tidy run: sudo apt update && sudo apt -y install clang-tidy diff --git a/.github/workflows/run-googletest.yml b/.github/workflows/run-googletest.yml index db967153b..d996feb72 100644 --- a/.github/workflows/run-googletest.yml +++ b/.github/workflows/run-googletest.yml @@ -16,7 +16,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v5 - name: Install Ninja shell: bash run: ${{ runner.os == 'macOS' && 'brew install ninja' || runner.os == 'Windows' && 'choco install ninja' || 'sudo apt-get install ninja-build' }} diff --git a/CMakeLists.txt b/CMakeLists.txt index e99a9ca8a..69dad3468 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -54,33 +54,6 @@ IF(BUILD_DOC) COMMENT "Building documentation with Doxygen.") ENDIF() -# Set up Rcpp -FetchContent_Declare( - rcpp - URL https://github.com/RcppCore/Rcpp/archive/refs/tags/1.0.8.zip -) -FetchContent_MakeAvailable(rcpp) - -# Set up R -MESSAGE(STATUS "Looking for R executable") - -EXECUTE_PROCESS( - COMMAND which R - OUTPUT_VARIABLE R_EXECUTABLE) - -MESSAGE(STATUS "R_EXECUTABLE is ${R_EXECUTABLE}") - -EXECUTE_PROCESS( - COMMAND R "--slave" "--no-save" "-e" "cat(R.home())" - OUTPUT_VARIABLE R_HOME) - -MESSAGE(STATUS "R_HOME is ${R_HOME}") - -EXECUTE_PROCESS( - COMMAND R "--slave" "--no-save" "-e" "remotes::install_local(upgrade = 'always')") -EXECUTE_PROCESS( - COMMAND R "--slave" "--no-save" "-e" "FIMS:::setup_gtest()") - # Enable testing for current directory and below enable_testing() @@ -91,8 +64,6 @@ add_library(fims_test INTERFACE) target_include_directories(fims_test INTERFACE inst/include - ${rcpp_SOURCE_DIR}/inst/include - ${R_HOME}/include ) # Add compile definition STD_LIB to the fims_test target. diff --git a/NAMESPACE b/NAMESPACE index b737001a8..cab5cf7f4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -64,7 +64,6 @@ export(initialize_process_distribution) export(initialize_process_structure) export(inv_logit) export(is.FIMSFit) -export(is.FIMSFits) export(log_error) export(log_info) export(log_warning) diff --git a/R/check_fims.R b/R/check_fims.R index 4ab7ea338..0a6fd8903 100644 --- a/R/check_fims.R +++ b/R/check_fims.R @@ -66,8 +66,7 @@ setup_gtest <- function() { #' @keywords developer #' @examples #' \dontrun{ -#' # TODO: add examples of strings passed to `...` -#' setup_and_run_gtest() +#' setup_and_run_gtest("--rerun-failed --output-on-failure") #' } setup_and_run_gtest <- function(...) { setup_gtest() diff --git a/R/data.R b/R/data.R new file mode 100644 index 000000000..5ac52511d --- /dev/null +++ b/R/data.R @@ -0,0 +1,76 @@ +#' FIMS input data frame +#' +#' A dataset containing information necessary 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). +#' +#' @format +#' A data frame with `r NROW(data1)` observations of `r NCOL(data1)` +#' 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{name}{A character string providing the name of the information source +#' that the data 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 +#' pertain to length.} +#' \item{datestart,dateend}{Start and end dates of the data collection period. +#' Format all dates using `yyyy-mm-dd`, which can accommodate fake years +#' such as `0001-01-01`.} +#' \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 +#' 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 +#' for value. For landings and indices of abundance this should be +#' the standard deviation of the logged observations if you are using the +#' lognormal distribution to fit your data. For composition data it will +#' be your input sample size. +#' } +#' } +#' @source \url{www.github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison} +"data1" + +#' small FIMS input data frame +#' +#' A dataset containing minimal information necessary to run an +#' age-structured stock +#' assessment model in FIMS. This data was generated using the script in +#' `/data-raw/data_small.R` and does not correspond to any realistic population +#' or sampling method (the values are mostly arbitrary). +#' +#' @format +#' A data frame with `r NROW(data_small)` observations of `r NCOL(data_small)` +#' 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{name}{A character string providing the name of the information source +#' that the data 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 +#' pertain to length.} +#' \item{datestart,dateend}{Start and end dates of the data collection period. +#' Format all dates using `yyyy-mm-dd`, which can accommodate fake years +#' such as `0001-01-01`.} +#' \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 +#' 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 +#' for value. For landings and indices of abundance this should be +#' the standard deviation of the logged observations if you are using the +#' lognormal distribution to fit your data. For composition data it will +#' be your input sample size. +#' } +#' } +#' @source None, this is a simulated dataset full of arbitrary values as defined in `/data-raw/data_small.R`. +"data_small" diff --git a/R/data1.R b/R/data1.R deleted file mode 100644 index 9980357d4..000000000 --- a/R/data1.R +++ /dev/null @@ -1,37 +0,0 @@ -#' FIMS input data frame -#' -#' A dataset containing information necessary 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). -#' -#' @format -#' A data frame with `r NROW(data1)` observations of `r NCOL(data1)` -#' 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{name}{A character string providing the name of the information source -#' that the data 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 -#' pertain to length.} -#' \item{datestart,dateend}{Start and end dates of the data collection period. -#' Format all dates using `yyyy-mm-dd`, which can accommodate fake years -#' such as `0001-01-01`.} -#' \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 -#' 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 -#' for value. For landings and indices of abundance this should be -#' the standard deviation of the logged observations if you are using the -#' lognormal distribution to fit your data. For composition data it will -#' be your input sample size. -#' } -#' } -#' @source \url{www.github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison} -"data1" diff --git a/R/distribution_formulas.R b/R/distribution_formulas.R index e3b1623d8..97672b494 100644 --- a/R/distribution_formulas.R +++ b/R/distribution_formulas.R @@ -290,7 +290,7 @@ initialize_data_distribution <- function( new_module <- methods::new(DlnormDistribution) # populate logged standard deviation parameter with log of input - # Using resize() and then assigning value to each element of log_sd diretly + # Using resize() and then assigning value to each element of log_sd directly # is correct, as creating a new ParameterVector for log_sd here would # trigger an error in integration tests with wrappers. new_module$log_sd$resize(length(sd[["value"]])) diff --git a/R/fimsfit.R b/R/fimsfit.R index 31c5fa802..9f17be9d6 100644 --- a/R/fimsfit.R +++ b/R/fimsfit.R @@ -22,11 +22,6 @@ utils::globalVariables(c( # TODO: Fix "no metadata object found to revise superClass" in sdreportOrList # TODO: Write more validity checks for FIMSFit # TODO: Better document the return of [get_estimates()], i.e., columns -# TODO: Decide if the error from is.FIMSFits should be a single FALSE or stop -# TODO: Decide if "total" should be a part of number_of_parameters because it -# can be calculated from fixed_effects + random_effects and would need to -# be calculated in print.FITFims() -# TODO: Determine if report should always use last.par.best # TODO: Make a helper function to add lower and upper CI for users in estimates # methods::setClass: ---- @@ -95,6 +90,12 @@ methods::setMethod( x@number_of_parameters, sep = "=" ) + total_parameters <- sum(x@number_of_parameters) + all_parameters_info <- c(number_of_parameters, paste( + "total", + total_parameters, + sep = "=" + )) div_digit <- cli::cli_div(theme = list(.val = list(digits = 5))) terminal_ssb <- sapply( x@report[["ssb"]], @@ -103,7 +104,7 @@ methods::setMethod( cli::cli_inform(c( "i" = "FIMS model version: {.val {x@version}}", "i" = "Total run time was {.val {rt}} {ru}", - "i" = "Number of parameters: {number_of_parameters}", + "i" = "Number of parameters: {all_parameters_info}", "i" = "Maximum gradient= {.val {x@max_gradient}}", "i" = "Negative log likelihood (NLL):", "*" = "Marginal NLL= {.val {x@opt$objective}}", @@ -343,21 +344,6 @@ is.FIMSFit <- function(x) { inherits(x, "FIMSFit") } -#' Check if an object is a list of FIMSFit objects -#' -#' @param x List of fits returned from multiple calls to [fit_fims()]. -#' @keywords fit_fims -#' @export -is.FIMSFits <- function(x) { - if (!is.list(x)) { - cli::cli_warn( - message = c("x" = "{.par x} is not a list -- something went wrong.") - ) - return(FALSE) - } - all(sapply(x, function(i) inherits(i, "FIMSFit"))) -} - # Constructors ---- #' Class constructors for class `FIMSFit` and associated child classes @@ -431,7 +417,6 @@ FIMSFit <- function( n_fixed_effects <- length(obj[["par"]]) n_random_effects <- length(obj[["env"]][["parList()"]][["re"]]) number_of_parameters <- c( - total = n_total, fixed_effects = n_fixed_effects, random_effects = n_random_effects ) @@ -712,6 +697,13 @@ fit_fims <- function(input, trace = 0 ), filename = NULL) { + # See issue 455 of sdmTMB to see what should be used. + # https://github.com/pbs-assess/sdmTMB/issues/455 + # NOTE: When we add implementation for newton step we need to + # review the above github issue to make sure we maintain continuity + # between outputs as last.par may not equal last.par.best due to + # the smallest newton gradient solution not matching the smallest + # likelihood value. This can cause sanity issues in output reporting. if (number_of_newton_steps > 0) { cli::cli_abort("Newton steps not implemented yet.") } diff --git a/R/initialize_modules.R b/R/initialize_modules.R index 66a61abb5..9030fad8c 100644 --- a/R/initialize_modules.R +++ b/R/initialize_modules.R @@ -820,15 +820,6 @@ initialize_fims <- function(parameters, data) { data_type = "landings" ) } - # TODO (Matthew): Determine if the "dims" field is required for DmultinomDistribution. - # We need to decide whether to: - # 1. Remove the "dims" field to maintain consistency with other distributions, or - # 2. Update all relevant R functions (e.g., initialize_data_distribution()) - # that call DmultinomDistribution to set the "dims" field. - # AMH comment: - # 1. dims field is needed to track the dimension of multivariate input - # 2. the pattern for multinomial is different because it is a multivariate distribution. - # Other multivariate distributions (e.g. MVNORM) will likely also need a dims field if ("age" %in% fleet_types && "AgeComp" %in% data_distribution_names_for_fleet_i) { diff --git a/R/reshape_output.R b/R/reshape_output.R index 4f22256ca..a25460e93 100644 --- a/R/reshape_output.R +++ b/R/reshape_output.R @@ -120,7 +120,7 @@ reshape_tmb_estimates <- function(obj, opt = NULL, parameter_names) { # Outline for the estimates table - # TODO: The fleet_name, age, length, and time columns are currently emplty. Matthew + # TODO: The fleet_name, age, length, and time columns are currently empty. Matthew # has started adding information to the JSON output in the dev-model-families branch. # We can populate these columns once the dev-model-families branch is merged # into dev. diff --git a/R/use-gtest-template.R b/R/use-gtest-template.R new file mode 100644 index 000000000..6d8b4c23c --- /dev/null +++ b/R/use-gtest-template.R @@ -0,0 +1,114 @@ +#' Create tests/gtest/test_*.cpp test file and register it in CMakeLists.txt +#' +#' This helper function generates a GoogleTest (gtest) C++ template file for a +#' given function and appends lines to `CMakeLists.txt` to register the test. +#' +#' @param name A string representing the combined name for the C++ test file +#' and CMake executable target. It must follow the format +#' `FileName_ClassName_FunctionName`, where +#' - `FileName` is the C++ source file name (e.g., "Logistic") +#' - `ClassName` is the C++ class name (e.g., "LogisticSelectivity") +#' - `FunctionName` is the C++ function name (e.g., "Evaluate") +#' and use underscores to separate each component. For example: +#' `Logistic_LogisticSelectivity_Evaluate`. +#' +#' If the function is not a member of a class, use a placeholder for +#' `ClassName`. For example: `FIMSMath_ClassName_Logistic`. +#' +#' The default is `FileName_ClassName_FunctionName`. +#' +#' @return +#' If successful, this function invisibly returns `TRUE` to allow for the +#' chaining of commands. If the function is unsuccessful, an error message is +#' returned. +#' +#' Three messages are also returned from the usethis package, which is used by +#' this function. The first states where the FIMS project is on your computer. +#' The second states the file path of the newly created file. The file will not +#' be automatically opened. The third states the test has been registered in +#' `tests/gtest/CMakeLists.txt`. +#' +#' @examples +#' \dontrun{ +#' # Create a new test file named +#' # "test_Logistic_LogisticSelectivity_Evaluate.cpp" for +#' # `LogisticSelectivity::evaluate()` in +#' # `inst/include/population_dynamics/selectivity/functors/logistic.hpp`. +#' +#' FIMS:::use_gtest_template(name = "Logistic_LogisticSelectivity_Evaluate") +#' } +#' +#' @keywords developer +use_gtest_template <- function(name = "FileName_ClassName_FunctionName") { + cmakelist_path <- file.path("tests", "gtest", "CMakeLists.txt") + # Check if the CMakeLists.txt file exists + if (!file.exists(cmakelist_path)) { + cli::cli_abort( + c("{.file {cmakelist_path}} does not exist.", + "i" = "Please ensure that the CMakeLists.txt file is present in the + {.file tests/gtest} directory." + ) + ) + } + + # TODO: add the ability to add a function to a file that already exists + # TODO: add the ability to also pass the arguments for the function or find + # them within the code base and ensure that the template includes the + # necessary structure for each input argument + # TODO: Change the paste calls to use glue::glue() to increase readability + + # Validate the name format + name_parts_list <- strsplit(x = name, split = "_")[[1]] + if (length(name_parts_list) != 3) { + cli::cli_abort( + c("Invalid {.var name} format.", + "i" = "Expected format: {.val FileName_ClassName_FunctionName}.", + "x" = "Received name: {.val {name}}." + ) + ) + } + # Extract parts from the name + file_name <- name_parts_list[[1]][1] + class_name <- name_parts_list[[1]][2] + function_name <- name_parts_list[[1]][3] + + # Create the test file + path <- file.path("tests", "gtest", paste0("test_", name, ".cpp")) + if (!file.exists(path)) { + usethis::use_template( + template = "gtest_template.cpp", + save_as = path, + data = list( + class_name = class_name, + function_name = function_name + ), + package = "FIMS" + ) + } else { + cli::cli_abort("{.file {path}} already exists.") + } + + # Register the test in tests/gtest/CMakeLists.txt + # Open in append mode + CON <- file(cmakelist_path, "a") + on.exit(close(CON), add = TRUE) + writeLines( + c( + paste0("\n\n# test_", name, ".cpp"), + paste0("add_executable(", name), + paste0(" test_", name, ".cpp"), + paste0(")\n"), + paste0("target_link_libraries(", name), + paste0(" gtest_main"), + paste0(" fims_test"), + paste0(")\n"), + paste0("gtest_discover_tests(", name, ")") + ), + CON + ) + cli::cli_alert_success( + "Registering test {.val {name}} in {.file {cmakelist_path}}." + ) + + invisible(TRUE) +} diff --git a/R/use_template.R b/R/use-testthat-template.R similarity index 99% rename from R/use_template.R rename to R/use-testthat-template.R index 215e4b2c4..7eda4bcc9 100644 --- a/R/use_template.R +++ b/R/use-testthat-template.R @@ -42,6 +42,8 @@ #' \dontrun{ #' FIMS:::use_testthat_template("new_function") #' } +#' +#' @keywords developer use_testthat_template <- function(name) { # TODO: add the ability to add a function to a file that already exists # TODO: add the ability to also pass the arguments for the function or find diff --git a/R/zzz.R b/R/zzz.R index c20f4fbe6..d277dcaf8 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,4 +1,30 @@ -Rcpp::loadModule(module = "fims", what = TRUE) +# Note +# +# Placing `Rcpp::loadModule(module = "fims", what = TRUE)` inside the +# `.onLoad` function has been observed to fix R session crashes when running +# `devtools::load_all()` followed by `devtools::test()` in the package +# development workflow. +# +# `Rcpp::loadModule()` is called to make all objects from C++ module +# "fims" accessible in R. +# `loadNamespace` calls `.onLoad()` before sealing the namespace and processing +# exports. +# This might provide `pkgload` (used by `devtools::load_all()` and +# `devtools::test()`) a more consistent state to manage the dynamic library +# during its unload/reload cycles in a development environment (Source: Gemini). +# +# There is no direct or explicit documentation stating that `Rcpp::loadModule()` +# must be called in `.onLoad()`. The `Rcpp` documentation mentions that for +# R 2.15.1 and later (e.g., from +# `https://github.com/RcppCore/Rcpp/blob/29b3b78df547e55dbcceb1c5e81a978f441dd58b/inst/skeleton/zzz.R`) +# `loadModule()` does not strictly need to be in `.onLoad()` +# because it "triggers a load action" internally. However, packages like +# `stan-dev/rstan` and several others do call `Rcpp::loadModule()` within +# their `.onLoad()` functions. See examples from +# https://github.com/search?q=Rcpp%3A%3AloadModule%28+zzz.R&type=code. +.onLoad <- function(libname, pkgname) { + Rcpp::loadModule(module = "fims", what = TRUE) +} .onUnload <- function(libpath) { library.dynam.unload("FIMS", libpath) diff --git a/README.md b/README.md index e356bcc07..d8deb22a7 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ [![FIMS status badge](https://noaa-fims.r-universe.dev/badges/FIMS)](https://noaa-fims.r-universe.dev/FIMS) - [![R-CMD-check](https://github.com/NOAA-FIMS/FIMS/workflows/call-r-cmd-check/badge.svg)](https://github.com/NOAA-FIMS/FIMS/actions) + [![R-CMD-check badge](https://github.com/NOAA-FIMS/FIMS/actions/workflows/call-r-cmd-check.yml/badge.svg?branch=main)](https://github.com/NOAA-FIMS/FIMS/actions/workflows/call-r-cmd-check.yml) [![Codecov test coverage](https://codecov.io/gh/NOAA-FIMS/FIMS/branch/main/graph/badge.svg)](https://app.codecov.io/gh/NOAA-FIMS/FIMS?branch=main) [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) @@ -35,6 +35,7 @@ All contributors participating and contributing to the FIMS project are expected + @@ -139,12 +140,24 @@ All contributions to this project are gratefully acknowledged using the [`allcon + + +
+abhinav-1305 + +
KyleShertzer-NOAA + + +
+alexjensen-NOAA + +
@@ -162,12 +175,6 @@ All contributions to this project are gratefully acknowledged using the [`allcon
Srajald - - - -
-alexjensen-NOAA - @@ -315,6 +322,7 @@ All contributions to this project are gratefully acknowledged using the [`allcon + ## NOAA Disclaimer This repository is a scientific product and is not official communication of the National Oceanic and Atmospheric Administration, or the United States Department of Commerce. All NOAA GitHub project code is provided on an 'as is' basis and the user assumes responsibility for its use. Any claims against the Department of Commerce or Department of Commerce bureaus stemming from the use of this GitHub project will be governed by all applicable Federal law. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by the Department of Commerce. The Department of Commerce seal and logo, or the seal and logo of a DOC bureau, shall not be used in any manner to imply endorsement of any commercial product or activity by DOC or the United States Government. diff --git a/data-raw/data1.R b/data-raw/data1.R index 897acab89..17f16691d 100644 --- a/data-raw/data1.R +++ b/data-raw/data1.R @@ -458,13 +458,6 @@ write.csv( file.path("FIMS_input_data.csv"), row.names = FALSE ) -# check csv can be read into R well -test_read <- utils::read.csv(file.path("FIMS_input_data.csv")) -# TODO: check if the following is needed before running expect_equal() -test_read[["datestart"]] <- as.Date(test_read[["datestart"]]) -test_read[["dateend"]] <- as.Date(test_read[["dateend"]]) -testthat::expect_equal(test_read, data1) -unlink("FIMS_input_data.csv") usethis::use_data(data1, overwrite = TRUE) on.exit(unlink(main_dir, recursive = TRUE), add = TRUE) diff --git a/data-raw/data_small.R b/data-raw/data_small.R new file mode 100644 index 000000000..f2b7c3ef4 --- /dev/null +++ b/data-raw/data_small.R @@ -0,0 +1,177 @@ +#' Create a small simulated data set using arbitrary inputs +#' +#' This data set isn't a realistic example like data1 but is much smaller +#' which may be useful for debugging. +#' +#' @details +#' * Currently has 3 years of data, 3 ages bins, 3 length bins, and 1 fleet. +#' * Contains landings, indices, age composition, length composition, +#' weight-at-age, and age-to-length conversion data. +#' * See also data-raw/data1.R +#' +#' @author Ian G. Taylor + +# set dimensions +years <- 1:3 +lengths <- c(10, 20, 30) +ages <- 1:3 +fleets <- 1 + +# create landings data (slowly increasing over 3 years) +landings <- tibble::tibble( + type = "landings", + name = paste0("fleet", fleets), + age = NA, + length = NA, + datestart = paste0(years, "-01-01"), + dateend = paste0(years, "-12-31"), + value = 1000 + 100 * years, + unit = "mt", + uncertainty = 0.01 +) + +# create indices data (slowly decreasing over 3 years) +indices <- tibble::tibble( + type = "index", + name = paste0("fleet", fleets), + age = NA, + length = NA, + datestart = paste0(years, "-01-01"), + dateend = paste0(years, "-12-31"), + value = 4000 - 100 * years, + unit = "mt", + uncertainty = 0.25 +) + +# age composition data (equal proportions across ages) +agecomps <- tidyr::expand_grid( + year = years, + age = ages +) |> + dplyr::mutate( + type = "age", + name = paste0("fleet", fleets), + age = age, + length = NA, + datestart = paste0(year, "-01-01"), + dateend = paste0(year, "-12-31"), + value = 1 / length(ages), + unit = "proportion", + uncertainty = 60 + ) |> + dplyr::select(-year) + +# length composition data (equal proportions across lengths) +lencomps <- tidyr::expand_grid( + year = years, + length = lengths +) |> + dplyr::mutate( + type = "length", + name = paste0("fleet", fleets), + age = NA, + length = length, + datestart = paste0(year, "-01-01"), + dateend = paste0(year, "-12-31"), + value = 1 / length(lengths), + unit = "proportion", + uncertainty = 120 + ) |> + dplyr::select(-year) + +# weight-at-age data (weight in kg equal to age, converted to mt) +weight_at_age <- tidyr::expand_grid( + year = years, + age = ages +) |> + dplyr::mutate( + type = "weight-at-age", + name = paste0("fleet", fleets), + age = age, + length = NA, + datestart = paste0(year, "-01-01"), + dateend = paste0(year, "-12-31"), + value = age / 1000, + unit = "mt", + uncertainty = NA + ) |> + dplyr::select(-year) + +# make up an age-to-length conversion matrix if 3 ages and 3 lengths +len_at_age_matrix <- matrix( + c(1.0, 0.0, 0.0, 0.1, 0.8, 0.1, 0.0, 0.3, 0.7), + nrow = length(ages), + byrow = TRUE +) +# if dimensions don't match (if not 3 x 3 as above), +# create simple diagonal matrix instead +if ( + nrow(len_at_age_matrix) != length(ages) || + ncol(len_at_age_matrix) != length(lengths) +) { + len_at_age_matrix <- matrix( + 0, + nrow = length(ages), + ncol = length(lengths) + ) + diag(len_at_age_matrix) <- 1 + # any ages beyond the number of lengths map to the final length bin + if (length(ages) > length(lengths)) { + len_at_age_matrix[ + (length(lengths) + 1):length(ages), + length(lengths) + ] <- 1 + } +} + +# simple function to get values from the age-to-length conversion matrix +# given age and length to use in the mutate() command with expand_grid() below +get_len_at_age_value <- function(age, length) { + age_idx <- match(age, ages) + length_idx <- match(length, lengths) + mapply(function(a, l) len_at_age_matrix[a, l], age_idx, length_idx) +} + +# create age-to-length conversion data +age_to_length_conversion <- tidyr::expand_grid( + year = years, + age = ages, + length = lengths +) |> + dplyr::mutate( + type = "age-to-length-conversion", + name = paste0("fleet", fleets), + age = age, + length = length, + datestart = paste0(year, "-01-01"), + dateend = paste0(year, "-12-31"), + value = get_len_at_age_value(age, length), + unit = "mt", + uncertainty = NA + ) |> + # reorder columns to match FIMSFrame format used in other tibbles above + dplyr::select( + type, + name, + age, + length, + datestart, + dateend, + value, + unit, + uncertainty + ) + +# combine all data sources and convert to FIMSFrame +data_small <- rbind( + landings, + indices, + agecomps, + lencomps, + weight_at_age, + age_to_length_conversion +) + +# save as .rda file for use in the package +usethis::use_data(data_small, overwrite = TRUE) +rm(list = ls()) diff --git a/data/data_small.rda b/data/data_small.rda new file mode 100644 index 000000000..9329b3b2a Binary files /dev/null and b/data/data_small.rda differ diff --git a/inst/WORDLIST b/inst/WORDLIST index ec2d1b093..afe4c5209 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,6 +1,8 @@ Arith Beverton BevertonHoltRecruitment +CMake +CMakeLists CMD CppAD CPUE @@ -11,6 +13,7 @@ EWAAgrowth FIMSFit FIMSFrame Fmort +GoogleTest JSON Lifecycle LogEntry @@ -36,6 +39,7 @@ cli cmake codebase cov +cpp cv cyclomatic dateend @@ -53,6 +57,7 @@ ggplot github googletest grey +gtest hpp init json diff --git a/inst/include/common/def.hpp b/inst/include/common/def.hpp index fcdc44d4d..92d7d9f46 100644 --- a/inst/include/common/def.hpp +++ b/inst/include/common/def.hpp @@ -74,7 +74,7 @@ #endif #endif -// The following rows initialize default log files for outputing model progress +// The following rows initialize default log files for outputting model progress // comments used to assist in diagnosing model issues and tracking progress. // These files will only be created if a logs folder is added to the root model // directory. diff --git a/inst/include/common/fims_vector.hpp b/inst/include/common/fims_vector.hpp index ffc21de55..6037adfd7 100644 --- a/inst/include/common/fims_vector.hpp +++ b/inst/include/common/fims_vector.hpp @@ -26,7 +26,7 @@ class Vector { std::vector vec_m; /** - * @brief friend comparison operator. Allows the operartor to see private + * @brief friend comparison operator. Allows the operator to see private * members of fims::Vector. */ template @@ -46,10 +46,10 @@ class Vector { typedef typename std::vector::reference reference; /*!*/ typedef typename std::vector::const_reference - const_reference; /*!*/ + const_reference; /*!*/ typedef typename std::vector::pointer pointer; /*!*/ typedef typename std::vector::const_pointer - const_pointer; /*!*/ + const_pointer; /*!*/ typedef typename std::vector::iterator iterator; /*!*/ typedef typename std::vector::const_iterator const_iterator; /*!*/ diff --git a/inst/include/common/information.hpp b/inst/include/common/information.hpp index 3872976e2..99d357468 100644 --- a/inst/include/common/information.hpp +++ b/inst/include/common/information.hpp @@ -464,7 +464,7 @@ class Information { } /** - * @brief Set pointers to the recruitment module referened in the population + * @brief Set pointers to the recruitment module referenced in the population * module. * * @param &valid_model reference to true/false boolean indicating whether @@ -503,7 +503,7 @@ class Information { } /** - * @brief Set pointers to the recruitment process module referened in the + * @brief Set pointers to the recruitment process module referenced in the * population module. * * @param &valid_model reference to true/false boolean indicating whether @@ -543,7 +543,7 @@ class Information { } /** - * @brief Set pointers to the growth module referened in the population + * @brief Set pointers to the growth module referenced in the population * module. * * @param &valid_model reference to true/false boolean indicating whether @@ -582,7 +582,7 @@ class Information { } /** - * @brief Set pointers to the maturity module referened in the population + * @brief Set pointers to the maturity module referenced in the population * module. * * @param &valid_model reference to true/false boolean indicating whether diff --git a/inst/include/common/model.hpp b/inst/include/common/model.hpp index a343d1332..901d80b07 100644 --- a/inst/include/common/model.hpp +++ b/inst/include/common/model.hpp @@ -147,7 +147,7 @@ class Model { // may need singleton // Prepare recruitment p->recruitment->Prepare(); - FIMS_INFO_LOG("Recruitmnt successfully prepared.") + FIMS_INFO_LOG("Recruitment successfully prepared.") } // Loop over and evaluate populations @@ -175,15 +175,15 @@ class Model { // may need singleton #ifdef TMB_MODEL f->of = this->of; #endif - FIMS_INFO_LOG("Begin evalulation for fleet " + fims::to_string(f->id)); + FIMS_INFO_LOG("Begin evaluation for fleet " + fims::to_string(f->id)); f->evaluate_age_comp(); if (f->nlengths > 0) { f->evaluate_length_comp(); } - FIMS_INFO_LOG("Begin evalulation of landings for fleet " + + FIMS_INFO_LOG("Begin evaluation of landings for fleet " + fims::to_string(f->id)); f->evaluate_landings(); - FIMS_INFO_LOG("Begin evalulation of index for fleet " + + FIMS_INFO_LOG("Begin evaluation of index for fleet " + fims::to_string(f->id)); f->evaluate_index(); } diff --git a/inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp b/inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp index 69771ca24..c46b9c2de 100644 --- a/inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp +++ b/inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp @@ -56,7 +56,7 @@ class Parameter { */ double max_m = std::numeric_limits::infinity(); /** - * @brief A string indicationg the estimation type. Options are: constant, + * @brief A string indicating the estimation type. Options are: constant, * fixed_effects, or random_effects, where the default is constant. */ SharedString estimation_type_m = SharedString("constant"); @@ -252,7 +252,6 @@ class ParameterVector { SEXP at(R_xlen_t pos) { if (static_cast(pos) == 0 || static_cast(pos) > this->storage_m->size()) { - Rcpp::Rcerr << "ParameterVector: Index out of range.\n"; throw std::invalid_argument("ParameterVector: Index out of range"); FIMS_ERROR_LOG(fims::to_string(pos) + "!<" + fims::to_string(this->size())); @@ -270,7 +269,6 @@ class ParameterVector { */ Parameter& get(size_t pos) { if (pos >= this->storage_m->size()) { - Rcpp::Rcerr << "ParameterVector: Index out of range.\n"; throw std::invalid_argument("ParameterVector: Index out of range"); } return (this->storage_m->at(pos)); @@ -539,7 +537,7 @@ class RealVector { SEXP at(R_xlen_t pos) { if (static_cast(pos) == 0 || static_cast(pos) > this->storage_m->size()) { - Rcpp::Rcout << "RealVector: Index out of range.\n"; + throw std::invalid_argument("RealVector: Index out of range"); FIMS_ERROR_LOG(fims::to_string(pos) + "!<" + fims::to_string(this->size())); return NULL; @@ -556,7 +554,6 @@ class RealVector { */ double& get(size_t pos) { if (pos >= this->storage_m->size()) { - Rcpp::Rcout << "RealVector: Index out of range.\n"; throw std::invalid_argument("RealVector: Index out of range"); } return (this->storage_m->at(pos)); diff --git a/inst/include/interface/rcpp/rcpp_objects/rcpp_models.hpp b/inst/include/interface/rcpp/rcpp_objects/rcpp_models.hpp index b80bdc3eb..7a11375a6 100644 --- a/inst/include/interface/rcpp/rcpp_objects/rcpp_models.hpp +++ b/inst/include/interface/rcpp/rcpp_objects/rcpp_models.hpp @@ -115,7 +115,7 @@ class CatchAtAgeInterface : public FisheryModelInterfaceBase { population_ids(other.population_ids) {} /** - * Metthod to add a population id to the set of population ids. + * Method to add a population id to the set of population ids. */ void AddPopulation(uint32_t id) { this->population_ids->insert(id); @@ -504,7 +504,7 @@ class CatchAtAgeInterface : public FisheryModelInterfaceBase { } /** - * @brief Minimimum method to calculate the minimum of an array or vector + * @brief Minimum method to calculate the minimum of an array or vector * of doubles. * * @param v @@ -544,7 +544,7 @@ class CatchAtAgeInterface : public FisheryModelInterfaceBase { Rcpp::List calculate_reference_points_population( PopulationInterface *population_interface, double maxF = 1.0, double step = 0.01) { - // //note: this algoritm is ported from the Meta-population + // //note: this algorithm is ported from the Meta-population // assessment system project and // //needs review @@ -662,7 +662,7 @@ class CatchAtAgeInterface : public FisheryModelInterfaceBase { // Z_age[nages - 1])); // spr[i] = sum(N_age * reprod); - // #warning This is propbably not correct + // #warning This is probably not correct // R_eq[i] = pop->recruitment->evaluate(spr[i], spr_F0); // // R_eq[i] = (R0 / ((5.0 * steep - 1.0) * spr[i])) * // // (BC * 4.0 * steep * spr[i] - spr_F0 * (1.0 - diff --git a/inst/include/models/functors/catch_at_age.hpp b/inst/include/models/functors/catch_at_age.hpp index 899367944..ce5fb06cf 100644 --- a/inst/include/models/functors/catch_at_age.hpp +++ b/inst/include/models/functors/catch_at_age.hpp @@ -975,7 +975,7 @@ class CatchAtAge : public FisheryModelBase { for (size_t y = 0; y < fleet->nyears; y++) { Type sum = static_cast(0.0); Type sum_obs = static_cast(0.0); - // robust_add is a small value to add to expected compostion + // robust_add is a small value to add to expected composition // proportions at age to stabilize likelihood calculations // when the expected proportions are close to zero. // Type robust_add = static_cast(0.0); // zeroed out before @@ -989,7 +989,7 @@ class CatchAtAge : public FisheryModelBase { // should be calculated from the retained landings or // the total population. These values are slightly different. // In the future this will have more impact as we implement - // timing rather than everything occuring at the start of + // timing rather than everything occurring at the start of // the year. if (fleet->fleet_observed_landings_data_id_m == -999) { this->fleet_derived_quantities[fleet->GetId()]["agecomp_expected"] @@ -1056,7 +1056,7 @@ class CatchAtAge : public FisheryModelBase { for (size_t y = 0; y < fleet->nyears; y++) { Type sum = static_cast(0.0); Type sum_obs = static_cast(0.0); - // robust_add is a small value to add to expected compostion + // robust_add is a small value to add to expected composition // proportions at age to stabilize likelihood calculations // when the expected proportions are close to zero. // Type robust_add = static_cast(0.0); // 0.0001; zeroed out @@ -1209,14 +1209,14 @@ class CatchAtAge : public FisheryModelBase { code for initial structure and recruitment 0 loops. Could also have started loops at 1 with initial structure and recruitment setup outside the loops. - year loop is extended to <= nyears because SSB is calculted as the start of - the year value and by extending one extra year we get estimates of the + year loop is extended to <= nyears because SSB is calculated as the start + of the year value and by extending one extra year we get estimates of the population structure at the end of the final year. An alternative approach would be to keep initial numbers at age in it's own vector and each year to include the population structure at the end of the year. This is likely a null point given that we are planning to modify to an event/stanza based - structure in later milestones which will elimitate this confusion by - explicity referencing the exact date (or period of averaging) at which any + structure in later milestones which will eliminate this confusion by + explicitly referencing the exact date (or period of averaging) at which any calculation or output is being made. */ for (size_t p = 0; p < this->populations.size(); p++) { diff --git a/inst/include/population_dynamics/README.md b/inst/include/population_dynamics/README.md index 4475dced2..898b27a41 100644 --- a/inst/include/population_dynamics/README.md +++ b/inst/include/population_dynamics/README.md @@ -2,7 +2,7 @@ This directory contains header files related to the population dynamics specified in FIMS. The population dynamics modules are responsible for modeling the growth, reproduction, and survival of populations over time. It includes classes and functions that define the population structure, life-history traits, and environmental factors that influence population dynamics. -Each folder in `population_dynamics` corresponds to a component of the population dynamics model. Given the complexity of the component, the structure in these folders within `population_dynamics` may differ. At a minimum there will be a .hpp file with the same name as the subfolder, e.g., `fleet/fleet.hpp`. This file will include an `ifndef` directive and `#include` statements. If the folder is empty other than this file, then the remainder of the file will define the component. If there are additional subdirectors along side the .hpp file, the file will end after the include statements that point to each of the files in the functions folder that sits next to this .hpp file. +Each folder in `population_dynamics` corresponds to a component of the population dynamics model. Given the complexity of the component, the structure in these folders within `population_dynamics` may differ. At a minimum there will be a .hpp file with the same name as the subfolder, e.g., `fleet/fleet.hpp`. This file will include an `ifndef` directive and `#include` statements. If the folder is empty other than this file, then the remainder of the file will define the component. If there are additional subdirectories along side the .hpp file, the file will end after the include statements that point to each of the files in the functions folder that sits next to this .hpp file. For the latter scenario, where a `functor` folder exists, inside the `functor` folder will be a .hpp file with _base attached to the component name, e.g., `population_dynamics/maturity/functors/maturity_base.hpp`. This _base.hpp file will define the base class for the module type. The base class should only need a constructor method and a number of methods (e.g., `evaluate()`) that are not specific to the type of functions available under the subfolders but reused for all objects of that class type. This is important for life-history processes where there is structural uncertainty in the model and users may wish to investigate different forms, e.g., Beverton--Holt versus Ricker stock--recruitment relationships. Often, there will only be one functor in the subfolder but there will still be a subfolder structure. This structure is to allow for future expansion of the module type. diff --git a/inst/include/population_dynamics/fleet/fleet.hpp b/inst/include/population_dynamics/fleet/fleet.hpp index 382a34ab2..562439ad6 100644 --- a/inst/include/population_dynamics/fleet/fleet.hpp +++ b/inst/include/population_dynamics/fleet/fleet.hpp @@ -128,7 +128,7 @@ struct Fleet : public fims_model_object::FIMSObject { virtual ~Fleet() {} /** - * @brief Intialize Fleet Class + * @brief Initialize Fleet Class * @param nyears The number of years in the model. * @param nages The number of ages in the model. * @param nlengths The number of lengths in the model. @@ -246,7 +246,7 @@ struct Fleet : public fims_model_object::FIMSObject { for (size_t y = 0; y < this->nyears; y++) { Type sum = static_cast(0.0); Type sum_obs = static_cast(0.0); - // robust_add is a small value to add to expected compostion + // robust_add is a small value to add to expected composition // proportions at age to stabilize likelihood calculations // when the expected proportions are close to zero. // Type robust_add = static_cast(0.0); // zeroed out before testing @@ -261,7 +261,7 @@ struct Fleet : public fims_model_object::FIMSObject { // should be calculated from the retained landings or // the total population. These values are slightly different. // In the future this will have more impact as we implement - // timing rather than everything occuring at the start of + // timing rather than everything occurring at the start of // the year. if (this->fleet_observed_landings_data_id_m == -999) { this->agecomp_expected[i_age_year] = @@ -309,7 +309,7 @@ struct Fleet : public fims_model_object::FIMSObject { for (size_t y = 0; y < this->nyears; y++) { Type sum = static_cast(0.0); Type sum_obs = static_cast(0.0); - // robust_add is a small value to add to expected compostion + // robust_add is a small value to add to expected composition // proportions at age to stabilize likelihood calculations // when the expected proportions are close to zero. // Type robust_add = static_cast(0.0); // 0.0001; zeroed out diff --git a/inst/include/population_dynamics/population/population.hpp b/inst/include/population_dynamics/population/population.hpp index 924dd8e24..0decf0f79 100644 --- a/inst/include/population_dynamics/population/population.hpp +++ b/inst/include/population_dynamics/population/population.hpp @@ -64,9 +64,9 @@ struct Population : public fims_model_object::FIMSObject { fims::Vector biomass; /*!< Derived quantity: total population biomass in each year*/ fims::Vector spawning_biomass; /*!< Derived quantity: Spawning_biomass*/ - fims::Vector unfished_biomass; /*!< Derived quanity + fims::Vector unfished_biomass; /*!< Derived quantity biomass assuming unfished*/ - fims::Vector unfished_spawning_biomass; /*!< Derived quanity Spawning + fims::Vector unfished_spawning_biomass; /*!< Derived quantity Spawning biomass assuming unfished*/ fims::Vector proportion_mature_at_age; /*!< Derived quantity: Proportion mature at age */ @@ -529,14 +529,14 @@ struct Population : public fims_model_object::FIMSObject { code for initial structure and recruitment 0 loops. Could also have started loops at 1 with initial structure and recruitment setup outside the loops. - year loop is extended to <= nyears because SSB is calculted as the start of - the year value and by extending one extra year we get estimates of the + year loop is extended to <= nyears because SSB is calculated as the start + of the year value and by extending one extra year we get estimates of the population structure at the end of the final year. An alternative approach would be to keep initial numbers at age in it's own vector and each year to include the population structure at the end of the year. This is likely a null point given that we are planning to modify to an event/stanza based - structure in later milestones which will elimitate this confusion by - explicity referencing the exact date (or period of averaging) at which any + structure in later milestones which will eliminate this confusion by + explicitly referencing the exact date (or period of averaging) at which any calculation or output is being made. */ for (size_t y = 0; y <= this->nyears; y++) { diff --git a/inst/include/population_dynamics/recruitment/functors/log_devs.hpp b/inst/include/population_dynamics/recruitment/functors/log_devs.hpp index f54e7729e..55f9989da 100644 --- a/inst/include/population_dynamics/recruitment/functors/log_devs.hpp +++ b/inst/include/population_dynamics/recruitment/functors/log_devs.hpp @@ -1,6 +1,6 @@ /** * @file log_devs.hpp - * @brief Encorporates error using the log recruitment deviations approach. + * @brief Incorporates error using the log recruitment deviations approach. * @details This function inherits from recruitment base. * @copyright This file is part of the NOAA, National Marine Fisheries Service * Fisheries Integrated Modeling System project. See LICENSE in the source diff --git a/inst/include/population_dynamics/recruitment/functors/log_r.hpp b/inst/include/population_dynamics/recruitment/functors/log_r.hpp index 60d01a1b9..2f46ee00e 100644 --- a/inst/include/population_dynamics/recruitment/functors/log_r.hpp +++ b/inst/include/population_dynamics/recruitment/functors/log_r.hpp @@ -1,6 +1,6 @@ /** * @file log_r.hpp - * @brief Encorporates error using the log recruitment approach. + * @brief Incorporates error using the log recruitment approach. * @details This function inherits from recruitment base. * @copyright This file is part of the NOAA, National Marine Fisheries Service * Fisheries Integrated Modeling System project. See LICENSE in the source diff --git a/inst/include/utilities/fims_json.hpp b/inst/include/utilities/fims_json.hpp index 5a68a991b..94f500a9b 100644 --- a/inst/include/utilities/fims_json.hpp +++ b/inst/include/utilities/fims_json.hpp @@ -12,6 +12,7 @@ */ #include #include +#include #include #include #include diff --git a/inst/templates/gtest_template.cpp b/inst/templates/gtest_template.cpp new file mode 100644 index 000000000..b05c6a2f6 --- /dev/null +++ b/inst/templates/gtest_template.cpp @@ -0,0 +1,86 @@ +// Instructions ---- +// This file follows the format generated by FIMS:::use_gtest_template(). +// Necessary tests include input and output (IO) correctness [IO +// correctness], edge-case handling [Edge handling], and built-in errors and +// warnings [Error handling]. See `?FIMS:::use_gtest_template` for more +// information. Every test should have a description comment. +// More assertion macros provided by GoogleTest can be found at +// https://google.github.io/googletest/reference/assertions.html. + +#include "gtest/gtest.h" +// TODO: Include the header file for the function being tested +// For example, if testing the `evaluate` member function of the +// `LogisticSelectivity` class, include the corresponding header in the test +// file `tests/gtest/test_population_dynamics_selectivity_logistic.cpp`: +// #include "population_dynamics/selectivity/functors/logistic.hpp" +#include "path/to/relevant/header_file.hpp" +// Include additional headers as needed +// For example, include to use `std::cerr` and `std::cout`: +// #include + +namespace +{ + // {{{ class_name }}}_{{{ function_name }}} + // IO correctness + TEST({{{ class_name }}}_{{{ function_name }}}, HandlesCorrectInput) { + // Setup + // Load or prepare any necessary data for testing + ...Prepare data here... + + // Test that {{{ function_name }}}(x) returns y. + EXPECT_EQ({{{ function_name }}}(x), y); + + // Test that value returned from {{{ function_name }}}(x) and y does + // not exceed the absolute error abound abs_error. + EXPECT_NEAR({{{ function_name }}}(x), y, abs_error); + + } + + // Edge handling + // Please remove/comment out the test template below if no edge cases are being + // tested. + TEST({{{ class_name }}}_{{{ function_name }}}, HandlesEdgeCase) { + // Setup + // Load or prepare any necessary data for testing + ...Prepare data here... + + // Test that {{{ function_name }}}(x) returns y. + EXPECT_EQ({{{ function_name }}}(x), y); + + // Test that {{{ function_name}}}(x) returns NaN for invalid inputs. + EXPECT_TRUE(std::isnan({{{ function_name }}}(x))); + } + + + // Error handling + // Please remove/comment out the test template below if there are no + // built-in errors/warnings. + TEST({{{ class_name }}}_{{{ function_name }}}, CaptureError) { + // Setup + // Load or prepare any necessary data for testing + ...Prepare data here... + + // Redirect std::cerr to capture error messages + // Create a stringstream to capture output + std::stringstream captured_cerr; + // Save the old buffer and redirect std::cerr to captured_cerr + // captured_cerr.rdbuf() is an in-memory stream, and it returns a pointer to + // its internal buffer. Internal buffer is a block of memory used to + // temporarily store data before it is written. + std::streambuf* old_cerr = std::cerr.rdbuf(captured_cerr.rdbuf()); + + // Call the function under test + {{{ function_name }}}(x); + + // Restore std::cerr to its original state + std::cerr.rdbuf(old_cerr); + + // Test that {{{ function_name }}}(x) returns expected error. + EXPECT_EQ( + // Get the captured error output as a string + captured_cerr.str(), + "Error: Expected error message.\n" + ); + } + +} \ No newline at end of file diff --git a/inst/templates/testthat_template.R b/inst/templates/testthat_template.R index 6feee08cf..0bcad99e9 100644 --- a/inst/templates/testthat_template.R +++ b/inst/templates/testthat_template.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # {{{ function_name }}} ---- ## Setup ---- diff --git a/man/data1.Rd b/man/data1.Rd index 60af10f74..f7c656317 100644 --- a/man/data1.Rd +++ b/man/data1.Rd @@ -1,5 +1,5 @@ % 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} diff --git a/man/data_small.Rd b/man/data_small.Rd new file mode 100644 index 000000000..f4d97e246 --- /dev/null +++ b/man/data_small.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{data_small} +\alias{data_small} +\title{small FIMS input data frame} +\format{ +A data frame with 60 observations of 9 +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{name}{A character string providing the name of the information source +that the data 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 +pertain to length.} +\item{datestart,dateend}{Start and end dates of the data collection period. +Format all dates using \code{yyyy-mm-dd}, which can accommodate fake years +such as \code{0001-01-01}.} +\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 +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 +for value. For landings and indices of abundance this should be +the standard deviation of the logged observations if you are using the +lognormal distribution to fit your data. For composition data it will +be your input sample size. +} +} +} +\source{ +None, this is a simulated dataset full of arbitrary values as defined in \verb{/data-raw/data_small.R}. +} +\usage{ +data_small +} +\description{ +A dataset containing minimal information necessary to run an +age-structured stock +assessment model in FIMS. This data was generated using the script in +\verb{/data-raw/data_small.R} and does not correspond to any realistic population +or sampling method (the values are mostly arbitrary). +} +\keyword{datasets} diff --git a/man/is.FIMSFits.Rd b/man/is.FIMSFits.Rd deleted file mode 100644 index 217507a01..000000000 --- a/man/is.FIMSFits.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fimsfit.R -\name{is.FIMSFits} -\alias{is.FIMSFits} -\title{Check if an object is a list of FIMSFit objects} -\usage{ -is.FIMSFits(x) -} -\arguments{ -\item{x}{List of fits returned from multiple calls to \code{\link[=fit_fims]{fit_fims()}}.} -} -\description{ -Check if an object is a list of FIMSFit objects -} -\keyword{fit_fims} diff --git a/man/setup_and_run_gtest.Rd b/man/setup_and_run_gtest.Rd index 8e0a91ab8..21a1de738 100644 --- a/man/setup_and_run_gtest.Rd +++ b/man/setup_and_run_gtest.Rd @@ -16,8 +16,7 @@ test suite from R. } \examples{ \dontrun{ -# TODO: add examples of strings passed to `...` -setup_and_run_gtest() +setup_and_run_gtest("--rerun-failed --output-on-failure") } } \keyword{developer} diff --git a/man/use_gtest_template.Rd b/man/use_gtest_template.Rd new file mode 100644 index 000000000..b9fd07393 --- /dev/null +++ b/man/use_gtest_template.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/use-gtest-template.R +\name{use_gtest_template} +\alias{use_gtest_template} +\title{Create tests/gtest/test_*.cpp test file and register it in CMakeLists.txt} +\usage{ +use_gtest_template(name = "FileName_ClassName_FunctionName") +} +\arguments{ +\item{name}{A string representing the combined name for the C++ test file +and CMake executable target. It must follow the format +\code{FileName_ClassName_FunctionName}, where +\itemize{ +\item \code{FileName} is the C++ source file name (e.g., "Logistic") +\item \code{ClassName} is the C++ class name (e.g., "LogisticSelectivity") +\item \code{FunctionName} is the C++ function name (e.g., "Evaluate") +and use underscores to separate each component. For example: +\code{Logistic_LogisticSelectivity_Evaluate}. +} + +If the function is not a member of a class, use a placeholder for +\code{ClassName}. For example: \code{FIMSMath_ClassName_Logistic}. + +The default is \code{FileName_ClassName_FunctionName}.} +} +\value{ +If successful, this function invisibly returns \code{TRUE} to allow for the +chaining of commands. If the function is unsuccessful, an error message is +returned. + +Three messages are also returned from the usethis package, which is used by +this function. The first states where the FIMS project is on your computer. +The second states the file path of the newly created file. The file will not +be automatically opened. The third states the test has been registered in +\code{tests/gtest/CMakeLists.txt}. +} +\description{ +This helper function generates a GoogleTest (gtest) C++ template file for a +given function and appends lines to \code{CMakeLists.txt} to register the test. +} +\examples{ +\dontrun{ +# Create a new test file named +# "test_Logistic_LogisticSelectivity_Evaluate.cpp" for +# `LogisticSelectivity::evaluate()` in +# `inst/include/population_dynamics/selectivity/functors/logistic.hpp`. + +FIMS:::use_gtest_template(name = "Logistic_LogisticSelectivity_Evaluate") +} + +} +\keyword{developer} diff --git a/man/use_testthat_template.Rd b/man/use_testthat_template.Rd index 40c82b541..ffaf93c52 100644 --- a/man/use_testthat_template.Rd +++ b/man/use_testthat_template.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/use_template.R +% Please edit documentation in R/use-testthat-template.R \name{use_testthat_template} \alias{use_testthat_template} \title{Create tests/testthat/test-*.R test file} @@ -51,4 +51,6 @@ will be used in the bookdown report of the testing results. \dontrun{ FIMS:::use_testthat_template("new_function") } + } +\keyword{developer} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index b369a34d9..12ab27a58 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -54,7 +54,6 @@ reference: contents: - has_keyword("developer") - has_keyword("set_methods") - - use_testthat_template - starts_with("reshape_") news: diff --git a/tests/README.md b/tests/README.md new file mode 100644 index 000000000..354323fa4 --- /dev/null +++ b/tests/README.md @@ -0,0 +1,104 @@ +# 🧪 Testing cheat sheet + +## Adding a new test + +### :scroll: Create a test file using `FIMS:::use_*_template()` + +- Calling [`FIMS:::use_gtest_template()`](https://noaa-fims.github.io/FIMS/reference/use_gtest_template.html) will create a new C++ test file, e.g., `tests/gtest/test_FileName_ClassName_FunctionName.cpp`, for GoogleTest and register the test in `tests/gtest/CMakeLists.txt`. + +- Calling [`FIMS:::use_testthat_template()`](https://noaa-fims.github.io/FIMS/reference/use_testthat_template.html) will create a new R test file, e.g., `tests/testthat/test-function_name.R`, for {testthat}. + +### 🛢️ Prepare test data for the new test + +Prepare the test data in the new file or in a separate file if you plan on reusing the data in multiple test files. + +- In-line test data: make the data directly in the new test file within the `setup` section. +- C++ reusable test data: create a fixture file, e.g., `tests/gtest/test_XXX_test_fixture.hpp`, to prepare reusable unit-test data, or create an integration file, e.g., `tests/gtest/integration/XXX.hpp`, to set up integration-test data for C++ tests. +- R reusable test data: add code to the `prepare_test_data()` function in [`tests/testthat/helper-integration-tests-setup-run.R`](https://github.com/NOAA-FIMS/FIMS/blob/main/tests/testthat/helper-integration-tests-setup-run.R), including code to save the new data object, e.g., `base::saveRDS(object, file = testthat::test_path("fixtures", "data_name.RDS"))`, and call `prepare_test_data()` in the `setup` section of the new test file to load the data using + ```r + if (!file.exists(test_path("fixtures", "data_name.RDS"))) { + 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(test_path("fixtures", "integration_test_data.RData"))` or within `prepare_test_data()`, where these data objects can be updated by running `R/data1.R`. + +### :pencil: Edit the code in the new test file + +Follow the structure of the new test file to write appropriate correctness, edge-handling, and error-handling tests. + +#### :hammer: Helper functions to set up tests + +The following :hammer: helper functions are available to assist with writing integration tests in R. + +- `setup_and_run_FIMS_without_wrappers()`: Set up a FIMS model without wrappers (in [`tests/testthat/helper-integration-tests-setup-run.R`](https://github.com/NOAA-FIMS/FIMS/blob/main/tests/testthat/helper-integration-tests-setup-run.R)). +- `setup_and_run_FIMS_with_wrappers()`: Set up a FIMS model with wrappers (in [`tests/testthat/helper-integration-tests-setup-run.R`](https://github.com/NOAA-FIMS/FIMS/blob/main/tests/testthat/helper-integration-tests-setup-run.R)). +- `verify_fims_deterministic()`: Compare the model output from a FIMS deterministic run against the expected "truth" from an operating model (in [`tests/testthat/helper-integration-tests-validation.R`](https://github.com/NOAA-FIMS/FIMS/blob/main/tests/testthat/helper-integration-tests-validation.R)). +- `verify_fims_nll()`: Compare the negative log likelihood (NLL) from a FIMS model against the expected NLL calculated from an operating model (in [`tests/testthat/helper-integration-tests-validation.R`](https://github.com/NOAA-FIMS/FIMS/blob/main/tests/testthat/helper-integration-tests-validation.R)). +- `validate_fims()`: Compare the output from a FIMS model where parameters are estimated against the expected "truth" from an operating model (in [`tests/testthat/helper-integration-tests-validation.R`](https://github.com/NOAA-FIMS/FIMS/blob/main/tests/testthat/helper-integration-tests-validation.R)). + +#### :shushing_face: Skipping tests + +The following {testthat} functions can be used at the beginning of a test file to skip tests under certain conditions: + +- Add [`testthat::skip_on_ci()`](https://testthat.r-lib.org/reference/skip.html) at the beginning of a test file to skip it during continuous integration runs. +- Add [`testthat::skip_on_covr()`](https://testthat.r-lib.org/reference/skip.html) at the beginning of a test file to skip it during coverage calculation. + +#### :mute: Suppressing messages + +- Messages for FIMS are suppressed globally in `tests/testthat.R` to keep test reports clean in the console and on GitHub Actions. If a specific function within a test still generates messages, wrap the call in `base::suppressMessages()` to silence its output. + +## :computer: Run tests + +### C++ + +- [`FIMS:::setup_and_run_gtest()`](https://noaa-fims.github.io/FIMS/reference/setup_and_run_gtest.html): +Set up integration test data and run the GoogleTest suite. +- [`FIMS:::run_gtest()`](https://noaa-fims.github.io/FIMS/reference/run_gtest.html): +Run the GoogleTest suite. + +### R + +- Run [`devtools::load_all()`](https://devtools.r-lib.org/reference/load_all.html) and [`devtools::test()`](https://devtools.r-lib.org/reference/test.html) to execute all tests in the package. +- Run [`devtools::test(filter = "test_file_name")`](https://devtools.r-lib.org/reference/test.html) to execute a specific test file. +- Run [`devtools::install()`](https://devtools.r-lib.org/reference/install.html) before running `test-parallel*-.R`. +- [`FIMS:::run_r_unit_tests()`](https://noaa-fims.github.io/FIMS/reference/run_r_unit_tests.html): Run all R unit tests in the package. +- [`FIMS:::run_r_integration_tests()`](https://noaa-fims.github.io/FIMS/reference/run_r_integration_tests.html): Run all R integration tests in the package. +- [`FIMS:::remove_test_data()`](https://noaa-fims.github.io/FIMS/reference/remove_test_data.html): Remove test data from `tests/testthat/fixtures` to run the tests from fresh if changes in the core code affect FIMS input or output. +- [`FIMS:::check_fims()`](https://noaa-fims.github.io/FIMS/reference/check_fims.html): Run all styling, documentation, and testing for FIMS repository. + +## :bug: Debug tests + +### C++ + +- Run following lines in terminal and use gdb to debug: +```bash +cmake -S . -B build -G Ninja -DCMAKE_BUILD_TYPE=Debug +cmake --build build --parallel +ctest --test-dir build --parallel +gdb ./build/tests/gtest/population_dynamics_population.exe +c // to continue without paging +run // to see which line of code is broken +print this->log_naa // for example, print this->log_naa to see the value of log_naa; +print i // for example, print i from the broken for loop +bt // backtrace +q // to quit +``` + +- Write print statements in the desired .hpp file +```cpp +nfleets = fleets.size(); +std::ofstream out("debug.txt"); +out < expected_unfished_numbers_at_age1(pop.nyears, 0.0); std::vector expected_unfished_spawning_biomass(pop.nyears, 0.0); diff --git a/tests/gtest/test_FIMSJson_JsonParser_WriteToFile.cpp b/tests/gtest/test_FIMSJson_JsonParser_WriteToFile.cpp new file mode 100644 index 000000000..309649841 --- /dev/null +++ b/tests/gtest/test_FIMSJson_JsonParser_WriteToFile.cpp @@ -0,0 +1,74 @@ +// Instructions ---- +// This file follows the format generated by FIMS:::use_gtest_template(). +// Necessary tests include input and output (IO) correctness [IO +// correctness], edge-case handling [Edge handling], and built-in errors and +// warnings [Error handling]. See `?FIMS:::use_gtest_template` for more +// information. Every test should have a description comment. +// More assertion macros provided by GoogleTest can be found at +// https://google.github.io/googletest/reference/assertions.html. + +#include "gtest/gtest.h" +// Include the header file for the function being tested +// For example, if testing the `evaluate` member function of the +// `LogisticSelectivity` class, include the corresponding header in the test +// file `tests/gtest/test_population_dynamics_selectivity_logistic.cpp`: +// #include "population_dynamics/selectivity/functors/logistic.hpp" +#include "utilities/fims_json.hpp" +// Include additional headers as needed +// For example, include to use `std::cerr` and `std::cout`: +// #include + +namespace +{ + // JsonParser_WriteToFile + // IO correctness + + // Edge handling + + // Error handling + TEST(JsonParser_WriteToFile, CaptureError) { + // Setup + // Load or prepare any necessary data for testing + + // Brings the JsonParser and JsonValue classes from the fims namespace into + // the local scope. This allows you to write 'JsonParser' instead of + // 'fims::JsonParser' in the code below. + using fims::JsonParser; + using fims::JsonValue; + + // Create an instance of JsonParser and a JSON value holding the number 42 + JsonParser parser; + JsonValue value(42); + + // Set up a string variable for a bad file path + // Note the test will fail if the path is just a non-existent file (e.g., + // std::string bad_path = "nonexistent_file.json";), because on most systems, + // if you try to open a file for writing in a directory that exists and you + // have write permissions, the file will be created if it does not exist. + std::string bad_path = "bad_path/nonexistent_file.json"; + + // Redirect std::cerr to capture error messages + // Create a stringstream to capture output + std::stringstream captured_cerr; + // Save the old buffer and redirect std::cerr to captured_cerr + // captured_cerr.rdbuf() is an in-memory stream, and it returns a pointer to + // its internal buffer. Internal buffer is a block of memory used to + // temporarily store data before it is written. + std::streambuf* old_cerr = std::cerr.rdbuf(captured_cerr.rdbuf()); + + // Call the WriteToFile function under test; should print an error to + // std::cerr if file can't be opened + parser.WriteToFile(bad_path, value); + + // Restore std::cerr to its original state + std::cerr.rdbuf(old_cerr); + + // Assert that the captured error output matches the expected error message + EXPECT_EQ( + // Get the captured error output as a string + captured_cerr.str(), + "Error: Unable to open file bad_path/nonexistent_file.json for writing.\n" + ); + } + +} diff --git a/tests/gtest/test_Logistic_LogisticSelectivity_Evaluate.cpp b/tests/gtest/test_Logistic_LogisticSelectivity_Evaluate.cpp new file mode 100644 index 000000000..1a6277b8b --- /dev/null +++ b/tests/gtest/test_Logistic_LogisticSelectivity_Evaluate.cpp @@ -0,0 +1,48 @@ +// Instructions ---- +// This file follows the format generated by FIMS:::use_gtest_template(). +// Necessary tests include input and output (IO) correctness [IO +// correctness], edge-case handling [Edge handling], and built-in errors and +// warnings [Error handling]. See `?FIMS:::use_gtest_template` for more +// information. Every test should have a description comment. +// More assertion macros provided by GoogleTest can be found at +// https://google.github.io/googletest/reference/assertions.html. + +#include "gtest/gtest.h" +// Include the header file for the function being tested +// For example, if testing the `evaluate` member function of the +// `LogisticSelectivity` class, include the corresponding header in the test +// file `tests/gtest/test_population_dynamics_selectivity_logistic.cpp`: +// #include "population_dynamics/selectivity/functors/logistic.hpp" +#include "population_dynamics/selectivity/functors/logistic.hpp" +// Include additional headers as needed +// For example, include to use `std::cerr` and `std::cout`: +// #include + +namespace +{ + // LogisticSelectivity_Evaluate + // IO correctness + TEST(LogisticSelectivity_Evaluate, HandlesCorrectInput) { + // Setup + // Load or prepare any necessary data for testing + fims_popdy::LogisticSelectivity fishery_selectivity; + fishery_selectivity.inflection_point.resize(1); + fishery_selectivity.slope.resize(1); + fishery_selectivity.inflection_point[0] = 20.5; + fishery_selectivity.slope[0] = 0.2; + double fishery_x = 40.5; + // 1.0/(1.0+exp(-(40.5-20.5)*0.2)) = 0.9820138 + double expect_fishery = 0.9820138; + + // Test that Evaluate(x) returns y. + EXPECT_NEAR(fishery_selectivity.evaluate(fishery_x), expect_fishery, 0.0001); + + } + + // Edge handling + // No edge cases. + + + // Error handling + // No built-in errors/warnings. +} \ No newline at end of file diff --git a/tests/gtest/test_population_dynamics_selectivity_logistic.cpp b/tests/gtest/test_population_dynamics_selectivity_logistic.cpp deleted file mode 100644 index ed0c72c47..000000000 --- a/tests/gtest/test_population_dynamics_selectivity_logistic.cpp +++ /dev/null @@ -1,24 +0,0 @@ -#include "gtest/gtest.h" -#include "population_dynamics/selectivity/functors/logistic.hpp" - -namespace -{ - - - TEST(LogisticSelectivity, CreateObject) - { - - fims_popdy::LogisticSelectivity fishery_selectivity; - fishery_selectivity.inflection_point.resize(1); - fishery_selectivity.slope.resize(1); - fishery_selectivity.inflection_point[0] = 20.5; - fishery_selectivity.slope[0] = 0.2; - double fishery_x = 40.5; - // 1.0/(1.0+exp(-(40.5-20.5)*0.2)) = 0.9820138 - double expect_fishery = 0.9820138; - EXPECT_NEAR(fishery_selectivity.evaluate(fishery_x), expect_fishery, 0.0001); - - - } - -} \ No newline at end of file diff --git a/tests/integration/debug-integration-tmb-nointerface.R b/tests/integration/debug-integration-tmb-nointerface.R deleted file mode 100644 index 39a5c0be0..000000000 --- a/tests/integration/debug-integration-tmb-nointerface.R +++ /dev/null @@ -1,3 +0,0 @@ -# run script from R in the command terminal -# compiler flags based on Windows machine -TMB:::gdbsource("tests/integration/integration_test_population_tmb_nointerface.R", interactive = TRUE) diff --git a/tests/integration/integration_test_population_tmb_nointerface.R b/tests/integration/integration_test_population_tmb_nointerface.R deleted file mode 100644 index c479afc93..000000000 --- a/tests/integration/integration_test_population_tmb_nointerface.R +++ /dev/null @@ -1,58 +0,0 @@ -path <- "tests/integration/" -om_output <- om_input <- NULL -c_case <- 0 -i_iter <- 1 - -github_dir <- paste0("https://github.com/NOAA-FIMS/Age_Structured_Stock_Assessment_Model_Comparison/raw/main/FIMS_integration_test_data/FIMS_C", c_case, "/output/OM/") -Rdata_file <- paste0("OM", i_iter, ".RData") # e.g. OM1.Rdata -# this loads the file directly from github -# (which was easier to figure out than downloading the Rdata first) -load(url(paste0(github_dir, Rdata_file))) - - -library(TMB) -# dyn.unload(dynlib(paste0(path, "integration_test_population_tmb_nointerface"))) -# compile(paste0(path, "integration_test_population_tmb_nointerface.cpp"), -# flags = "-DTMB_MODEL") -# compile in debugging mode (flags set for Windows machine) -compile(paste0(path, "integration_test_population_tmb_nointerface.cpp"), - flags = "-DTMB_MODEL -O1 -g", DLLFLAGS = "" -) -dyn.load(dynlib(paste0(path, "integration_test_population_tmb_nointerface"))) - -# Need code chunk below to run with data: -# data("data1", package = "FIMS") -# fims_frame <- FIMSFrame(data1) - -naa <- c( - 993947.488, 811707.7933, 661434.4148, 537804.7782, - 436664.0013, 354303.3502, 287396.9718, 233100.2412, 189054.0219, - 153328.4354, 124353.2448, 533681.2692 -) - -Dat <- list( - fleet_num = 1, - survey_num = 1, - yr = om_input$nyr, - ages = om_input$ages - 1, - W_kg = om_input$W.kg, - ln_M = log(om_input$M), - init_naa = naa -) - -Par <- list( - fleet_sel_A50 = om_input$sel_fleet$fleet1$A50.sel, - fleet_sel_slope = om_input$sel_fleet$fleet1$slope.sel, - surv_sel_A50 = om_input$sel_survey$survey1$A50.sel, - surv_sel_slope = om_input$sel_survey$survey1$slope.sel, - log_Fmort = as.matrix(log(om_input$f)), - R0 = om_input$R0, - h = om_input$h, - logR_sd = om_input$logR_sd, - A50_mat = om_input$A50.mat, - slope_mat = om_input$slope.mat -) -# crashes Rstudio - next step: comment out population -obj <- MakeADFun(Dat, Par, DLL = "integration_test_population_tmb_nointerface") -rep <- obj$report() -rep$pop_naa diff --git a/tests/integration/integration_test_population_tmb_nointerface.cpp b/tests/integration/integration_test_population_tmb_nointerface.cpp deleted file mode 100644 index 12f6c0a60..000000000 --- a/tests/integration/integration_test_population_tmb_nointerface.cpp +++ /dev/null @@ -1,172 +0,0 @@ -#include "../../inst/include/distributions/distributions.hpp" -#include "../../inst/include/interface/interface.hpp" -#include "../../inst/include/common/data_object.hpp" -#include "../../inst/include/population_dynamics/fleet/fleet.hpp" -#include "../../inst/include/population_dynamics/population/population.hpp" - -template -Type objective_function::operator()(){ - - DATA_INTEGER(fleet_num); - DATA_INTEGER(survey_num); - DATA_IVECTOR(yr); - DATA_VECTOR(ages); - //Curently not set up to run with data - // DATA_VECTOR(observed_index_data); //nyears - //DATA_VECTOR(observed_agecomp_data); //nyears x nages - DATA_VECTOR(W_kg); - DATA_SCALAR(ln_M); - DATA_VECTOR(init_naa); - - PARAMETER_VECTOR(fleet_sel_A50); //nfleets - PARAMETER_VECTOR(fleet_sel_slope); //nfleets - PARAMETER_VECTOR(surv_sel_A50); //nsurveys - PARAMETER_VECTOR(surv_sel_slope); //nsurveys - PARAMETER_MATRIX(log_Fmort); //nyears x nfleets; - PARAMETER(R0); - PARAMETER(h); - PARAMETER(logR_sd); - PARAMETER(A50_mat); - PARAMETER(slope_mat); - - int nyears = yr.size(); - int nages = ages.size(); - int nfleets = fleet_num; - int nsurveys = survey_num; - - vector log_q(nyears); - //Is log_q supposed to be 1 or 0? - log_q.fill(1); - - fims_popdy::Population pop; - - - - for (int i = 0; i < nfleets; i++) { - - std::shared_ptr > f = std::make_shared >(); - f->Initialize(nyears, nages); - //f->nyears = nyears; - - //f->observed_index_data = std::make_shared >(nyears); - //f->observed_agecomp_data = std::make_shared >(nyears, nages); - /* - * To run with data, need to change 45 and 46 to: - * for(int y=0; y < nyears; y++){ - f->observed_index_data[y] = observed_index_data(y); - for(int a=0; a < nages; a ++){ - int idx = y * nages + a; - f->observed_agecomp_data[idx] = observed_agecomp_data(idx); - - } - } - **Note: this code chunk doesn't compile with error: no match for 'operator[]' - **(operand types are 'std::shared_ptr > > > >' and 'int') - */ - - - //set up selectivity - std::shared_ptr > selectivity - = std::make_shared >(); - - selectivity->inflection_point = fleet_sel_A50(i); - selectivity->slope = fleet_sel_slope(i); - f->selectivity = selectivity; - - for(int y = 0; ylog_Fmort[y] = log_Fmort(y,i); - f->log_q[y] = log_q(y); - //Setting outside Prepare as Prepare() causing segfault - f->Fmort[y] = exp(log_Fmort(y,i)); - f->q[y] = exp(log_q(y)); - } - //Prepare function causing segfault - // f->Prepare(nyears); - - - pop.fleets.push_back(f); - - } - - for (int i = 0; i < nsurveys; i++) { - - std::shared_ptr > s = std::make_shared >(); - s->Initialize(nyears, nages); - - - - //s->observed_index_data = std::make_shared >(nyears); - //s->observed_agecomp_data = std::make_shared >(nyears, nages); - - //set up selectivity - - - std::shared_ptr > selectivity - = std::make_shared >(); - - selectivity->inflection_point = surv_sel_A50(i); - selectivity->slope = surv_sel_slope(i); - s->selectivity = selectivity; - for(int y = 0; ylog_q[y] = log_q(y); - s->q[y] = exp(log_q(y)); - } - - //Prepare function causing segfault - //s->Prepare(); - pop.fleets.push_back(s); - } - - pop.nfleets = pop.fleets.size(); - - //initialize population - pop.Initialize(nyears, 1, nages); - - //Set initial size to value from MCP (read in through R) - for(int i=0; i < pop.nages; i++) { - pop.log_init_naa[i] = log(init_naa[i]); - pop.ages[i] = asDouble(ages(i)); - } - for(int i=0; i > rec = - std::make_shared >(); - rec->rzero = R0; - rec->steep = h; - /*the log_recruit_dev vector does not include a value for year == 0 - and is of length nyears - 1 where the first position of the vector - corresponds to the second year of the time series.*/ - rec->log_recruit_devs.resize(nyears-1); - std::fill(rec->log_recruit_devs.begin(), rec->log_recruit_devs.end(), 0.0); - pop.recruitment = rec; - - //Set maturity - std::shared_ptr > mat = - std::make_shared >(); - mat->inflection_point = A50_mat; - mat->slope = slope_mat; - pop.maturity = mat; - - //set empirical growth - std::shared_ptr > growth - = std::make_shared > (); - for (int i = 0; i < nages; i++) { - growth->ewaa[ asDouble(ages(i))] = asDouble(W_kg(i))/1000; - } - pop.growth = growth; - - pop.Evaluate(); - - vector pop_naa = pop.numbers_at_age; - - Type nll = 0; - - REPORT(pop_naa); - - return nll; -} - - diff --git a/tests/testthat.R b/tests/testthat.R index c860115fd..13df8a485 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,18 @@ +# The verbosity settings below apply when running devtools::test() locally. + +# Save the current verbosity setting +option_verbosity <- getOption("rlib_message_verbosity") +# Set verbosity to quiet for testing +options(rlib_message_verbosity = "quiet") + library(testthat) library(FIMS) test_check("FIMS") + +# Restore the original verbosity setting after tests +if (!is.null(option_verbosity)) { + options(rlib_message_verbosity = option_verbosity) +} else { + options(rlib_message_verbosity = NULL) +} diff --git a/tests/testthat/_snaps/get_estimates.md b/tests/testthat/_snaps/get_estimates.md index a4de072b4..66b2eaf77 100644 --- a/tests/testthat/_snaps/get_estimates.md +++ b/tests/testthat/_snaps/get_estimates.md @@ -1615,7 +1615,7 @@ 309 315 NA NA NA -6.94e- 1 NA NA 310 352 NA NA NA 1.5 e+ 0 NA NA 311 353 NA NA NA 2 e+ 0 NA NA - 312 354 NA NA NA -1.49e+ 1 NA NA + 312 354 NA NA NA 0 NA NA 313 355 NA NA NA -2 e+ 2 NA NA 314 362 NA NA NA 1.26e-16 NA NA 315 363 NA NA NA 8.39e-11 NA NA diff --git a/tests/testthat/helper-aaa-quiet-test-output.R b/tests/testthat/helper-aaa-quiet-test-output.R new file mode 100644 index 000000000..ccec90263 --- /dev/null +++ b/tests/testthat/helper-aaa-quiet-test-output.R @@ -0,0 +1,8 @@ +# The verbosity settings below apply when running testthat::test_package(), +# which mimics the "Show testthat output" step in the call-r-cmd-check GitHub +# Action workflow. + +# Save the current verbosity setting +option_verbosity <- getOption("rlib_message_verbosity") +# Set verbosity to quiet for testing +options(rlib_message_verbosity = "quiet") diff --git a/tests/testthat/helper-integration-tests-setup-function.R b/tests/testthat/helper-integration-tests-setup-function.R index f219f26e1..76fe34c0c 100644 --- a/tests/testthat/helper-integration-tests-setup-function.R +++ b/tests/testthat/helper-integration-tests-setup-function.R @@ -13,7 +13,7 @@ #' @param p A numeric non-negative vector of length K, specifying the probability #' for the K classes; must sum 1. #' -#' @return The log of the probability mass function for the multinomal. +#' @return The log of the probability mass function for the multinomial. FIMS_dmultinom <- function(x, p) { xp1 <- x + 1 log_pmf <- lgamma(sum(x) + 1) - sum(lgamma(xp1)) + sum(x * log(p)) @@ -271,10 +271,7 @@ setup_and_run_FIMS_without_wrappers <- function(iter_id, survey_fleet$age_to_length_conversion$resize(om_input[["nages"]] * om_input[["nlengths"]]) # TODO: Check that the dimensions of the matrix of age_to_length_conversion matrix # is rows = length() and columns = length() - # TODO: Fix code below to not use 1:x and instead use seq_along() where this - # doesn't currently break because we are only testing models with both - # age and length data but it would break for only age data. - for (i in 1:length(em_input[["age_to_length_conversion"]])) { + for (i in seq_along(em_input[["age_to_length_conversion"]])) { # Transposing the below will have NO impact on the results if the object is # already a vector. Additionally, c() ensures that the result is a vector # to be consistent but a matrix would be okay. @@ -445,7 +442,7 @@ setup_and_run_FIMS_without_wrappers <- function(iter_id, ) obj <- TMB::MakeADFun( data = list(), parameters, DLL = "FIMS", - silent = FALSE, map = map, random = "re" + silent = TRUE, map = map, random = "re" ) # Optimization with nlminb @@ -460,6 +457,7 @@ setup_and_run_FIMS_without_wrappers <- function(iter_id, # the initial values if optimization is skipped report <- obj[["report"]](obj[["env"]][["last.par.best"]]) + sdr <- TMB::sdreport(obj) sdr_report <- summary(sdr, "report") sdr_fixed <- summary(sdr, "fixed") @@ -583,6 +581,20 @@ setup_and_run_FIMS_with_wrappers <- function(iter_id, modified_parameters = modified_parameters[[iter_id]] ) + # The model will not always run when log_q is very small. + # We will need to make sure log_q is the true value for deterministic runs but + # then reset to log(1.0) for estimation runs. + if (estimation_mode == TRUE) { + parameters <- parameters |> + update_parameters( + modified_parameters = list( + survey1 = list( + Fleet.log_q.value = log(1.0) + ) + ) + ) + } + parameter_list <- initialize_fims( parameters = parameters, data = data diff --git a/tests/testthat/test-check_fims.R b/tests/testthat/test-check_fims.R index 509861303..4a3447d79 100644 --- a/tests/testthat/test-check_fims.R +++ b/tests/testthat/test-check_fims.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # check_fims ---- ## Setup ---- diff --git a/tests/testthat/test-create_default_parameters.R b/tests/testthat/test-create_default_parameters.R index 41711558f..49c1168ed 100644 --- a/tests/testthat/test-create_default_parameters.R +++ b/tests/testthat/test-create_default_parameters.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # create_default_* ---- ## Setup ---- diff --git a/tests/testthat/test-data_small.R b/tests/testthat/test-data_small.R new file mode 100644 index 000000000..c459c0c7f --- /dev/null +++ b/tests/testthat/test-data_small.R @@ -0,0 +1,72 @@ +# Instructions ---- +#' This file follows the format generated by FIMS:::use_testthat_template(). +#' Necessary tests include input and output (IO) correctness [IO +#' correctness], edge-case handling [Edge handling], and built-in errors and +#' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more +#' information. Every test should have a @description tag that takes up just +#' one line, which will be used in the bookdown report of {testthat} results. + +# data_small ---- +## Setup ---- +# Load or prepare any necessary data for testing + +fims_frame <- FIMS::FIMSFrame(data_small) + +## IO correctness ---- +test_that("fims_frame() works with the correct inputs", { + #' @description Test that [fims_frame()] creates the S4 FIMSFrame classes. + expect_s4_class(fims_frame, "FIMSFrame") +}) + +## Setup and run a model using data_small ---- + +# Define fleet specification +fleet1 <- list( + selectivity = list(form = "LogisticSelectivity"), + data_distribution = c( + Landings = "DlnormDistribution", + AgeComp = "DmultinomDistribution", + LengthComp = "DmultinomDistribution" + ) +) + +# create default parameters for the model +# TODO: remove this once the change described in +# https://github.com/orgs/NOAA-FIMS/discussions/944#discussioncomment-14097152 +# is completed which will make maturity parameters constant by default. +parameters <- fims_frame |> + create_default_parameters(fleets = list(fleet1 = fleet1)) |> + update_parameters( + modified_parameters = list( + maturity = list( + LogisticMaturity.inflection_point.value = 0.9, + LogisticMaturity.inflection_point.estimation_type = "constant", + LogisticMaturity.slope.value = 0.1, + LogisticMaturity.slope.estimation_type = "constant" + ) + ) + ) |> + # I'm not sure this is working to turn on estimation of q + update_parameters( + modified_parameters = list( + fleet1 = list( + Fleet.log_q.estimation_type = "fixed_effects" + ) + ) + ) + +# Run the model with optimization +fit <- parameters |> + initialize_fims(data = fims_frame) |> + fit_fims(optimize = TRUE) + +test_that("model successfully ran with optimization to fit to data_small", { + #' @description Test that [fit] is of the class FIMSFit. + expect_true(is.FIMSFit(fit)) +}) + +## Edge handling ---- +# No edge cases to test. + +## Error handling ---- +# No built-in errors to test. diff --git a/tests/testthat/test-distribution-formulas.R b/tests/testthat/test-distribution-formulas.R index c340906ba..a3baf0f70 100644 --- a/tests/testthat/test-distribution-formulas.R +++ b/tests/testthat/test-distribution-formulas.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # distribution_formulas ---- ## Setup ---- @@ -104,7 +105,7 @@ test_that("initialize_process_distribution() works with correct inputs", { expect_equal(length(recruitment$log_devs), length(recruitment_distribution$x)) #' @description Test that [initialize_process_distribution()] matches - #' the dimesnions of x and expected values. + #' the dimensions of x and expected values. expect_equal( length(recruitment_distribution$x), length(recruitment_distribution$expected_values) diff --git a/tests/testthat/test-fimsfit.R b/tests/testthat/test-fimsfit.R index 2603877aa..57ed17842 100644 --- a/tests/testthat/test-fimsfit.R +++ b/tests/testthat/test-fimsfit.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # FIMSFit ---- ## Setup ---- @@ -25,11 +26,6 @@ test_that("is.FIMSFit() works with correct inputs", { object = is.FIMSFit(fit_age_length_comp) ) - #' @description Test that is.FIMSFits(fit_list) returns TRUE. - expect_true( - object = is.FIMSFits(fit_list) - ) - #' @description Test that as.list(fit_age_length_comp) returns a nested list. expect_equal( object = typeof(as.list(fit_age_length_comp)), @@ -72,11 +68,4 @@ test_that("is.FIMSFit() returns correct outputs for edge cases", { }) ## Error handling ---- -test_that("is.FIMSFits() returns correct error messages", { - #' @description Test that is.FIMSFits(fit_age_length_comp) returns expected - #' error. - expect_warning( - object = is.FIMSFits(fit_age_length_comp), - regexp = "x is not a list -- something went wrong." - ) -}) +# No built-in errors to test. diff --git a/tests/testthat/test-fimsframe.R b/tests/testthat/test-fimsframe.R index 6214b0fcb..4bff71eeb 100644 --- a/tests/testthat/test-fimsframe.R +++ b/tests/testthat/test-fimsframe.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # fims_frame ---- ## Setup ---- @@ -68,7 +69,7 @@ test_that("fims_frame() works with the correct inputs", { #' @description Test that the `show()` method works as expected on a FIMSFrame #' object. - expect_output(show(fims_frame)) + expect_output(suppressMessages(show(fims_frame))) }) ## Edge handling ---- diff --git a/tests/testthat/test-get_estimates.R b/tests/testthat/test-get_estimates.R index 9c4e11e41..a14bed97a 100644 --- a/tests/testthat/test-get_estimates.R +++ b/tests/testthat/test-get_estimates.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_estimates ---- ## Setup ---- diff --git a/tests/testthat/test-get_fits.R b/tests/testthat/test-get_fits.R index 8bd340bae..a799864f6 100644 --- a/tests/testthat/test-get_fits.R +++ b/tests/testthat/test-get_fits.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_fits ---- ## Setup ---- diff --git a/tests/testthat/test-get_fixed.R b/tests/testthat/test-get_fixed.R index 50909b3d5..b964ae7a3 100644 --- a/tests/testthat/test-get_fixed.R +++ b/tests/testthat/test-get_fixed.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # Setup ---- # Load or prepare any necessary data for testing diff --git a/tests/testthat/test-get_input.R b/tests/testthat/test-get_input.R index da9ac0c0d..ee42e9575 100644 --- a/tests/testthat/test-get_input.R +++ b/tests/testthat/test-get_input.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_input ---- ## Setup ---- diff --git a/tests/testthat/test-get_max_gradient.R b/tests/testthat/test-get_max_gradient.R index cd217a15b..a623e41b2 100644 --- a/tests/testthat/test-get_max_gradient.R +++ b/tests/testthat/test-get_max_gradient.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_max_gradient ---- ## Setup ---- diff --git a/tests/testthat/test-get_number_parameters.R b/tests/testthat/test-get_number_parameters.R index f6c7926a4..9c41f1fc3 100644 --- a/tests/testthat/test-get_number_parameters.R +++ b/tests/testthat/test-get_number_parameters.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_number_of_parameters ---- ## Setup ---- @@ -30,7 +31,6 @@ test_that("get_number_of_parameters() works with correct inputs", { expected_n_random_effects <- length(fit_data@obj[["env"]][["parList()"]][["re"]]) number_of_parameters <- get_number_of_parameters(fit_data) expected_vector <- c( - total = expected_n_total, fixed_effects = expected_n_fixed_effects, random_effects = expected_n_random_effects ) diff --git a/tests/testthat/test-get_obj.R b/tests/testthat/test-get_obj.R index 1dd82f53f..7293bdca7 100644 --- a/tests/testthat/test-get_obj.R +++ b/tests/testthat/test-get_obj.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_obj ---- ## Setup ---- diff --git a/tests/testthat/test-get_opt.R b/tests/testthat/test-get_opt.R index 3e2b98434..a8310d4c1 100644 --- a/tests/testthat/test-get_opt.R +++ b/tests/testthat/test-get_opt.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_opt ---- ## Setup ---- diff --git a/tests/testthat/test-get_random.R b/tests/testthat/test-get_random.R index 320434e61..a576541b0 100644 --- a/tests/testthat/test-get_random.R +++ b/tests/testthat/test-get_random.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # Setup ---- # Load or prepare any necessary data for testing diff --git a/tests/testthat/test-get_sdreport.R b/tests/testthat/test-get_sdreport.R index c464bfd98..8d82fc185 100644 --- a/tests/testthat/test-get_sdreport.R +++ b/tests/testthat/test-get_sdreport.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_sdreport ---- ## Setup ---- diff --git a/tests/testthat/test-get_timing.R b/tests/testthat/test-get_timing.R index f31bdf786..94ac5440f 100644 --- a/tests/testthat/test-get_timing.R +++ b/tests/testthat/test-get_timing.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_timing ---- ## Setup ---- diff --git a/tests/testthat/test-get_version.R b/tests/testthat/test-get_version.R index 5ba9abc95..44066d4e6 100644 --- a/tests/testthat/test-get_version.R +++ b/tests/testthat/test-get_version.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # get_version ---- ## Setup ---- diff --git a/tests/testthat/test-initialize_modules.R b/tests/testthat/test-initialize_modules.R index 49805d6a6..4c65ed6e2 100644 --- a/tests/testthat/test-initialize_modules.R +++ b/tests/testthat/test-initialize_modules.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # test_initialize_modules ---- ## Setup ---- @@ -170,7 +171,7 @@ test_that("initialize_fims returns correct error messages", { clear() #' @description Test that [initialize_fims()] correctly returns an error when - #' the lenfths of value and estimation_type do not match + #' the lengths of value and estimation_type do not match parameters_wrong_type[["parameters"]][["recruitment"]][["BevertonHoltRecruitment.log_devs.estimation_type"]] <- c("fixed_effects", "fixed_effects") expect_error( initialize_fims(parameters = parameters_wrong_type, data = data), diff --git a/tests/testthat/test-integration-caa-mle-wrappers.R b/tests/testthat/test-integration-caa-mle-wrappers.R index b4102e676..6d503bac8 100644 --- a/tests/testthat/test-integration-caa-mle-wrappers.R +++ b/tests/testthat/test-integration-caa-mle-wrappers.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # Deterministic test ---- ## Setup ---- @@ -47,9 +48,9 @@ test_that("deterministic run returns correct nlls", { ) test_that("deterministic run results correct number of parameters and random effects", { - #' @description Veryify the number of parameters are correct + #' @description Verify the number of parameters are correct expect_equal(get_number_of_parameters(deterministic_age_length_comp)["fixed_effects"] |> unname(), 77) - #' @description Veryify the number of random effects are correct + #' @description Verify the number of random effects are correct expect_equal(get_number_of_parameters(deterministic_age_length_comp)["random_effects"] |> unname(), 0) }) }) diff --git a/tests/testthat/test-integration-caa-mle.R b/tests/testthat/test-integration-caa-mle.R index d804452ab..c1ac2f08d 100644 --- a/tests/testthat/test-integration-caa-mle.R +++ b/tests/testthat/test-integration-caa-mle.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # Deterministic test ---- ## Setup ---- diff --git a/tests/testthat/test-integration-fims-estimation-random-effects-without-wrappers.R b/tests/testthat/test-integration-fims-estimation-random-effects-without-wrappers.R index 8dcaa7f26..077fcaae6 100644 --- a/tests/testthat/test-integration-fims-estimation-random-effects-without-wrappers.R +++ b/tests/testthat/test-integration-fims-estimation-random-effects-without-wrappers.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # Deterministic test ---- ## Setup ---- @@ -48,9 +49,9 @@ test_that("deterministic run returns correct nlls", { }) test_that("deterministic run results correct number of parameters and random effects", { - #' @description Veryify the number of parameters are correct + #' @description Verify the number of parameters are correct expect_equal(length(result[["obj"]][["par"]]), 49) - #' @description Veryify the number of random effects are correct + #' @description Verify the number of random effects are correct expect_equal(length(result[["obj"]][["env"]][["random"]]), 29) }) diff --git a/tests/testthat/test-is_fims_verbose.R b/tests/testthat/test-is_fims_verbose.R index 5cc34a01d..2e24f047e 100644 --- a/tests/testthat/test-is_fims_verbose.R +++ b/tests/testthat/test-is_fims_verbose.R @@ -3,36 +3,33 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # is_fims_verbose ---- ## Setup ---- # Load or prepare any necessary data for testing -option_verbosity <- getOption("rlib_message_verbosity") -on.exit(options("rlib_message_verbosity" = option_verbosity), add = TRUE) ## IO correctness ---- test_that("is_fims_verbose() works with correct inputs", { #' @description Test that is_fims_verbose() returns a boolean. expect_type(object = is_fims_verbose(), "logical") - #' @description Test that is_fims_verbose() returns TRUE by default. - expect_true(is_fims_verbose()) - - options("rlib_message_verbosity" = "quiet") - #' @description Test that you can turn it to FALSE by setting the global - #' verbosity option using `setOption()`. + #' @description Test that is_fims_verbose() returns FALSE by default because + #' of the settings in the helper-quiet-test-output.R file. expect_false(is_fims_verbose()) }) ## Edge handling ---- test_that("is_fims_verbose() returns correct outputs for edge cases", { + # Save the current verbosity setting + current_verbosity <- getOption("rlib_message_verbosity") + options("rlib_message_verbosity" = "verbose") + # Restore the original verbosity setting on exit + on.exit(options("rlib_message_verbosity" = current_verbosity), add = TRUE) #' @description Test that "verbose" works for setting the verbosity. - expect_true({ - options("rlib_message_verbosity" = "verbose") - is_fims_verbose() - }) + expect_true(is_fims_verbose()) }) ## Error handling ---- diff --git a/tests/testthat/test-logit.R b/tests/testthat/test-logit.R index 3580a69bc..6f6199eb1 100644 --- a/tests/testthat/test-logit.R +++ b/tests/testthat/test-logit.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # logit ---- ## Setup ---- diff --git a/tests/testthat/test-parallel-caa-mle-wrappers.R b/tests/testthat/test-parallel-caa-mle-wrappers.R index 1d47f4a0f..5b34e189f 100644 --- a/tests/testthat/test-parallel-caa-mle-wrappers.R +++ b/tests/testthat/test-parallel-caa-mle-wrappers.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # Run FIMS in serial and parallel ---- # This test demonstrates how to run the FIMS model in both serial and parallel @@ -47,7 +48,7 @@ for (i in 1:sim_num) { survey1 = list( LogisticSelectivity.inflection_point.value = 1.5, LogisticSelectivity.slope.value = 2, - Fleet.log_q.value = log(om_output_list[[i]][["survey_q"]][["survey1"]]) + Fleet.log_q.value = log(1.0) ), recruitment = list( BevertonHoltRecruitment.log_rzero.value = log(om_input_list[[i]][["R0"]]), diff --git a/tests/testthat/test-rcpp-data.R b/tests/testthat/test-rcpp-data.R index d1805267b..23d553713 100644 --- a/tests/testthat/test-rcpp-data.R +++ b/tests/testthat/test-rcpp-data.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp data ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-distribution.R b/tests/testthat/test-rcpp-distribution.R index 7ffef04a4..e7b3bcc6c 100644 --- a/tests/testthat/test-rcpp-distribution.R +++ b/tests/testthat/test-rcpp-distribution.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp distribution ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-ewaa.R b/tests/testthat/test-rcpp-ewaa.R index 499d5a825..5064e538d 100644 --- a/tests/testthat/test-rcpp-ewaa.R +++ b/tests/testthat/test-rcpp-ewaa.R @@ -3,8 +3,9 @@ #' Necessary tests include (1) Input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # EWAAgrowth ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-fims.R b/tests/testthat/test-rcpp-fims.R index d75af897b..a3724e019 100644 --- a/tests/testthat/test-rcpp-fims.R +++ b/tests/testthat/test-rcpp-fims.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp modules ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-fleet-interface.R b/tests/testthat/test-rcpp-fleet-interface.R index 9551a3d24..dbcd1ad96 100644 --- a/tests/testthat/test-rcpp-fleet-interface.R +++ b/tests/testthat/test-rcpp-fleet-interface.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp fleet ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-maturity.R b/tests/testthat/test-rcpp-maturity.R index 33300450f..207fba826 100644 --- a/tests/testthat/test-rcpp-maturity.R +++ b/tests/testthat/test-rcpp-maturity.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp maturity ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-parameter-vector.R b/tests/testthat/test-rcpp-parameter-vector.R index 4218d33d7..6cbb44968 100644 --- a/tests/testthat/test-rcpp-parameter-vector.R +++ b/tests/testthat/test-rcpp-parameter-vector.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp variable vector ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-population-interface.R b/tests/testthat/test-rcpp-population-interface.R index f7658dac7..88fb8c350 100644 --- a/tests/testthat/test-rcpp-population-interface.R +++ b/tests/testthat/test-rcpp-population-interface.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp population interface ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-recruitment-interface.R b/tests/testthat/test-rcpp-recruitment-interface.R index 972b9e535..89932a647 100644 --- a/tests/testthat/test-rcpp-recruitment-interface.R +++ b/tests/testthat/test-rcpp-recruitment-interface.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp recruitment interface ---- ## Setup ---- diff --git a/tests/testthat/test-rcpp-selectivity.R b/tests/testthat/test-rcpp-selectivity.R index e31744012..f91e8e3eb 100644 --- a/tests/testthat/test-rcpp-selectivity.R +++ b/tests/testthat/test-rcpp-selectivity.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # rcpp selectivity ---- ## Setup ---- diff --git a/tests/testthat/test-update_parameters.R b/tests/testthat/test-update_parameters.R index be4fbb53d..32f41d988 100644 --- a/tests/testthat/test-update_parameters.R +++ b/tests/testthat/test-update_parameters.R @@ -3,8 +3,9 @@ #' Necessary tests include input and output (IO) correctness [IO #' correctness], edge-case handling [Edge handling], and built-in errors and #' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. # update_parameters ---- diff --git a/tests/testthat/test-use-test-template.R b/tests/testthat/test-use-test-template.R new file mode 100644 index 000000000..7c26b6bc3 --- /dev/null +++ b/tests/testthat/test-use-test-template.R @@ -0,0 +1,175 @@ +# Instructions ---- +#' This file follows the format generated by FIMS:::use_testthat_template(). +#' Necessary tests include input and output (IO) correctness [IO +#' correctness], edge-case handling [Edge handling], and built-in errors and +#' warnings [Error handling]. See `?FIMS:::use_gtest_template` for more +#' information. Every test should have a @description tag, which can span +#' multiple lines, that will be used in the bookdown report of the results from +#' {testthat}. + + +# use_*_template ---- +## setup ---- +# Set up for all of the use_*_template functions in the following section. + +# Create a temporary package structure with the minimal files necessary for +# testing purposes in a temporary directory. And, ensure the temporary directory +# is cleaned up after the tests are complete. +temp_path <- file.path(tempdir(), "rcmdcheck") +# Must use showWarnings = FALSE or attempt to remove the directory before +# creating it because if you run this function more than once the directory will +# exist, though it will be empty. +dir.create(temp_path, showWarnings = FALSE) +on.exit( + unlink(temp_path, recursive = TRUE, force = TRUE), + add = TRUE +) +# Save the current working directory and set the new one for the temporary +# package but ensure that the working directory is reset at the end +old_wd <- getwd() +setwd(temp_path) +on.exit(setwd(old_wd), add = TRUE) +# Create a new package at the specified path +pkg <- suppressMessages( + invisible(capture.output( + usethis::create_package(temp_path), + type = "output" + )) +) +suppressMessages(usethis::proj_set(temp_path)) +suppressMessages(usethis::use_testthat()) +# Add a folder `gtest` for GoogleTest files +suppressMessages(usethis::use_directory(file.path("tests", "gtest"))) +# Add a `CMakeLists.txt`` file in the `tests/gtest` directory +cmakelist_path <- file.path("tests", "gtest", "CMakeLists.txt") +file.create(cmakelist_path) + +# use_gtest_template ---- +## setup ---- +# No additional setup is needed. + +## IO correctness ---- +test_that("use_gtest_template() works with correct inputs", { + suppressMessages(FIMS:::use_gtest_template( + name = "FIMSMath_ClassName_Logistic" + )) + #' @description Test that use_gtest_template() creates the correct test file. + expect_true(file.exists(file.path( + temp_path, "tests", "gtest", "test_FIMSMath_ClassName_Logistic.cpp" + ))) + + #' @description Test that use_gtest_template() creates the correct CMake file. + expect_true(file.exists(file.path(temp_path, cmakelist_path))) + + # TODO: Make this test live by fixing the grepl statement + suppressMessages(FIMS:::use_gtest_template( + name = "FIMSMath_ClassName_FunctionName" + )) + + # Search for the expected lines in the CMakeLists.txt file + first_entry <- grepl( + "test_FIMSMath_ClassName_Logistic.cpp", + readLines(file.path(temp_path, cmakelist_path)) + ) + second_entry <- grepl( + "test_FIMSMath_ClassName_FunctionName.cpp", + readLines(file.path(temp_path, cmakelist_path)) + ) + #' @description Test that use_gtest_template() appends the correct lines to + #' CMakeLists.txt when an additional test is added rather than writing over + #' it. + expect_true(any(first_entry)) + expect_true(any(second_entry)) + #' @description Test that use_gtest_template() appends the new test after the + #' previous test in CMakeLists.txt. + expect_gt(which(second_entry)[1], which(first_entry)[1]) +}) + +## Edge handling ---- +test_that("use_gtest_template() handles edge cases correctly", { + #' @description Test that use_gtest_template() throws an error when format of name is wrong. + expect_error( + object = FIMS:::use_gtest_template( + name = "ClassName_FunctionName" + ), + regexp = "Invalid `name` format" + ) +}) + +## Error handling ---- +test_that("use_gtest_template() returns correct error messages", { + #' @description Test that use_gtest_template() throws an error when the file + #' already exists. + error <- tryCatch( + FIMS:::use_gtest_template( + name = "FIMSMath_ClassName_Logistic" + ), + error = function(e) { + # Return a custom error message if an error occurs + "An error occurred." + } + ) + expect_equal(error, "An error occurred.") + + file.rename( + from = file.path(temp_path, cmakelist_path), + to = file.path(temp_path, "tests", "gtest", "renamed.txt") + ) + #' @description Test that use_gtest_template() throws an error if the + #' CMakeLists file does not already exist. + expect_error( + object = suppressMessages(FIMS:::use_gtest_template( + name = "FIMSMath_ClassName_FunctionName" + )) + ) + file.rename( + from = file.path(temp_path, "tests", "gtest", "renamed.txt"), + to = file.path(temp_path, cmakelist_path) + ) +}) + +# use_testthat_template ---- +## setup ---- +# No additional setup is needed. + +## IO correctness ---- +test_that("use_testthat_template() works with correct inputs", { + suppressMessages(FIMS:::use_testthat_template("individual_function")) + #' @description Test that use_testthat_template("individual_function") + #' creates the correct file. + expect_true(file.exists( + file.path( + temp_path, "tests", "testthat", "test-individual_function.R" + ) + )) + + suppressMessages(FIMS:::use_testthat_template("function-group")) + #' @description Test that use_testthat_template("function-group") creates the + #' correct file. + expect_true(file.exists( + file.path( + temp_path, "tests", "testthat", "test-function-group.R" + ) + )) +}) + +## Edge handling ---- +test_that("use_testthat_template() handles edge cases correctly", { + #' @description Test that use_testthat_template() throws an error when no input is provided. + expect_error(object = FIMS:::use_testthat_template()) +}) + +## Error handling ---- +test_that("use_testthat_template() returns correct error messages", { + # Attempt to use the test template again inside a tryCatch to capture any + # potential errors + error <- tryCatch(FIMS:::use_testthat_template("individual_function"), + error = function(e) { + # Return a custom error message if an error occurs + "An error occurred." + } + ) + #' @description Test that use_testthat_template("individual_function") throws + #' an error when the file already exists. + expect_equal(error, "An error occurred.") +}) diff --git a/tests/testthat/test-use-testthat-template.R b/tests/testthat/test-use-testthat-template.R deleted file mode 100644 index 0c36a8b30..000000000 --- a/tests/testthat/test-use-testthat-template.R +++ /dev/null @@ -1,79 +0,0 @@ -# Instructions ---- -#' This file follows the format generated by FIMS:::use_testthat_template(). -#' Necessary tests include input and output (IO) correctness [IO -#' correctness], edge-case handling [Edge handling], and built-in errors and -#' warnings [Error handling]. See `?FIMS:::use_testthat_template` for more -#' information. Every test should have a @description tag that takes up just -#' one line, which will be used in the bookdown report of {testthat} results. - - -# use_testthat_template ---- -## setup ---- -# Create temporary files for testing purposes -create_temporary_file <- function(temp_path) { - # Create the directory for the temporary package - dir.create(temp_path) - # Save the current working directory and set the new one for the temporary - # package - old_wd <- getwd() - setwd(temp_path) - # Ensure that the working directory is reset after the function exits - on.exit(setwd(old_wd), add = TRUE) - # Create a new package at the specified path - pkg <- usethis::create_package(temp_path) - # Set the project to the temporary package directory - usethis::proj_set(temp_path) - # Initialize the {testthat} framework for testing - usethis::use_testthat() - # Add a test to the package using the test template - FIMS:::use_testthat_template("individual_function") - FIMS:::use_testthat_template("function-group") - # Attempt to use the test template again inside a tryCatch to capture any - # potential errors - error <- tryCatch(FIMS:::use_testthat_template("individual_function"), - error = function(e) { - # Return a custom error message if an error occurs - "An error occurred." - } - ) - # Return details about the created package, including paths and any errors - output <- list( - folder_path = temp_path, - individual_function_path = file.path( - temp_path, "tests", "testthat", "test-individual_function.R" - ), - function_group_path = file.path( - temp_path, "tests", "testthat", "test-function-group.R" - ), - error = error - ) -} - -# Generate temporary files for testing -temp_path <- file.path(tempdir(), "rcmdcheck") -unlink(temp_path, recursive = TRUE, force = TRUE) -output <- create_temporary_file(temp_path) -# Ensure the temporary folder is cleaned up after tests are complete -on.exit(unlink(output[["folder_path"]], recursive = TRUE, force = TRUE), add = TRUE) -on.exit(unlink(temp_path)) - -## IO correctness ---- -test_that("use_testthat_template() works with correct inputs", { - #' @description Test that use_testthat_template("individual_function") creates the correct file. - expect_true(file.exists(output[["individual_function_path"]])) - - #' @description Test that use_testthat_template("function-group") creates the correct file. - expect_true(file.exists(output[["function_group_path"]])) -}) - -## Edge handling ---- -test_that("use_testthat_template() handles edge cases correctly", { - #' @description Test that use_testthat_template() throws an error when no input is provided. - expect_error(object = FIMS:::use_testthat_template()) -}) - -## Error handling ---- -test_that("use_testthat_template() throws an error if the file already exists", { - #' @description Test that use_testthat_template("individual_function") throws an error when the file already exists. - expect_equal(output[["error"]], "An error occurred.") -})