diff --git a/.github/workflows/run-pollock-tests-by-fleet.yml b/.github/workflows/run-pollock-tests-by-fleet.yml new file mode 100644 index 0000000..abbc654 --- /dev/null +++ b/.github/workflows/run-pollock-tests-by-fleet.yml @@ -0,0 +1,39 @@ +on: + workflow_dispatch: + +name: Run pollock tests (by fleet) + +jobs: + build-deploy: + runs-on: macos-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - name: Check out repository + uses: actions/checkout@v2 + + - name: Set up R (needed for Rmd) + uses: r-lib/actions/setup-r@v2 + + - name: Run pollock tests + run: | + # Names of required packages + packages <- c("dplyr", "tidyr", "ggplot2", "TMB", "reshape2", "here", "remotes", "lubridate") + + # Install packages not yet installed + installed_packages <- packages %in% rownames(installed.packages()) + if (any(installed_packages == FALSE)) { + install.packages(packages[!installed_packages], repos = "http://cran.us.r-project.org") + } + + install.packages("FIMS", repos = c("https://noaa-fims.r-universe.dev", "https://cloud.r-project.org")) + + # Load packages + invisible(lapply(packages, library, character.only = TRUE)) + + source(file.path(getwd(), "content", "run_pollock_tests_by_fleet.R")) + shell: Rscript {0} + + - name: Upload artifact + uses: actions/upload-pages-artifact@v3 diff --git a/.github/workflows/run-pollock-tests-by-process.yml b/.github/workflows/run-pollock-tests-by-process.yml new file mode 100644 index 0000000..c5afddc --- /dev/null +++ b/.github/workflows/run-pollock-tests-by-process.yml @@ -0,0 +1,39 @@ +on: + workflow_dispatch: + +name: Run pollock tests (by process) + +jobs: + build-deploy: + runs-on: macos-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - name: Check out repository + uses: actions/checkout@v2 + + - name: Set up R (needed for Rmd) + uses: r-lib/actions/setup-r@v2 + + - name: Run pollock tests + run: | + # Names of required packages + packages <- c("TMB") + + # Install packages not yet installed + installed_packages <- packages %in% rownames(installed.packages()) + if (any(installed_packages == FALSE)) { + install.packages(packages[!installed_packages], repos = "http://cran.us.r-project.org") + } + + install.packages("FIMS", repos = c("https://noaa-fims.r-universe.dev", "https://cloud.r-project.org")) + + # Load packages + invisible(lapply(packages, library, character.only = TRUE)) + + source(file.path(getwd(), "content", "run_pollock_tests.R")) + shell: Rscript {0} + + - name: Upload artifact + uses: actions/upload-pages-artifact@v3 diff --git a/content/R/pk_prepare_dat.R b/content/R/pk_prepare_dat.R index 79e58d9..680f0d4 100644 --- a/content/R/pk_prepare_dat.R +++ b/content/R/pk_prepare_dat.R @@ -2,14 +2,12 @@ ## build a FIMS and PK data set that match -pkfitfinal <- readRDS("data_files/pkfitfinal.RDS") -pkfit0 <- readRDS("data_files/pkfit0.RDS") +pkfitfinal <- readRDS(file.path(getwd(), "content", "data_files", "pkfitfinal.RDS")) +pkfit0 <- readRDS(file.path(getwd(), "content", "data_files", "pkfit0.RDS")) parfinal <- pkfitfinal$obj$env$parList() -pkinput0 <- readRDS('data_files/pkinput0.RDS') +pkinput0 <- readRDS(file.path(getwd(), "content", "data_files", "pkinput0.RDS")) fimsdat <- pkdat0 <- pkinput0$dat -pkinput <- readRDS('data_files/pkinput.RDS') - - +pkinput <- readRDS(file.path(getwd(), "content", "data_files", "pkinput.RDS")) ## need to fill missing years with -999 so it's ignored in FIMS ind2 <- 0 * pkfit0$rep$Eindxsurv2 - 999 diff --git a/content/run_pollock_tests.R b/content/run_pollock_tests.R index d06db58..e82f952 100644 --- a/content/run_pollock_tests.R +++ b/content/run_pollock_tests.R @@ -13,7 +13,8 @@ ages <- 1:nages ## This will fit the models bridging to FIMS (simplifying) ## source("fit_bridge_models.R") ## compare changes to model -source("R/pk_prepare_dat.R") +# source("R/pk_prepare_dat.R") +source(file.path(getwd(), "content", "R", "pk_prepare_dat.R")) ## Some global settings which I Think we can ignore for now estimate_fish_selex <- TRUE estimate_survey_selex <- TRUE @@ -27,7 +28,8 @@ estimate_recdevs <- TRUE clear() clear_logs() -source("R/pk_prepare_FIMS_inputs.R") +# source("R/pk_prepare_FIMS_inputs.R") +source(file.path(getwd(), "content", "R", "pk_prepare_FIMS_inputs.R")) ## make FIMS model success <- CreateTMBModel() parameters <- list(p = get_fixed()) @@ -38,7 +40,8 @@ rep1 <- obj1$report() ## Organize input lists by process clear() clear_logs() -source("R/pk_prepare_FIMS_inputs_by_process.R") +# source("R/pk_prepare_FIMS_inputs_by_process.R") +source(file.path(getwd(), "content", "R", "pk_prepare_FIMS_inputs_by_process.R")) ## make FIMS model success <- CreateTMBModel() parameters <- list(p = get_fixed()) diff --git a/content/run_pollock_tests_by_fleet.R b/content/run_pollock_tests_by_fleet.R index aa53120..f51c3b2 100644 --- a/content/run_pollock_tests_by_fleet.R +++ b/content/run_pollock_tests_by_fleet.R @@ -1,14 +1,14 @@ ## define the dimensions and global variables library(FIMS) -source("R/pk_prepare_FIMS_inputs_by_fleet.R") +source(file.path(getwd(), "content", "R", "pk_prepare_FIMS_inputs_by_fleet.R")) years <- 1970:2023 nyears <- length(years) nseasons <- 1 nages <- 10 ages <- 1:nages -source("R/pk_prepare_dat.R") +source(file.path(getwd(), "content", "R", "pk_prepare_dat.R")) # test R functions: approach 1 -------------------------------------------- @@ -194,115 +194,115 @@ clear_logs() # test R functions: approach 2 -------------------------------------------- -selectivity_double_logistic <- set_selectivity( - form = "DoubleLogisticSelectivity", - initial_values = c( - parfinal$inf1_fsh_mean, exp(parfinal$log_slp1_fsh_mean), - parfinal$inf2_fsh_mean, exp(parfinal$log_slp2_fsh_mean) - ), - is_estimated = rep(TRUE, 4), - is_random_effect = rep(FALSE, 4) -) - -selectivity_logistic <- set_selectivity( - form = "LogisticSelectivity", - initial_values = c( - parfinal$inf1_fsh_mean, exp(parfinal$log_slp1_fsh_mean) - ), - is_estimated = rep(TRUE, 2), - is_random_effect = rep(FALSE, 2) -) - -selectivity <- vector(mode = "list", length = 4) -selectivity[[1]] <- selectivity[[2]] <- selectivity_double_logistic -selectivity[[3]] <- selectivity_logistic -selectivity[[4]] <- selectivity_double_logistic # Order matters because the selectivity modules assign unique IDs. - -fleet <- set_fleet( - data = age_frame, - is_estimated_obs_error = list(FALSE, FALSE, FALSE, FALSE), - selectivity_ctl = NULL, - selectivity_module_list = selectivity, - Fmort_ctl = list( - is_survey = list(FALSE, TRUE, TRUE, TRUE), - estimate_F = list(TRUE, FALSE, FALSE, FALSE), - random_F = list(FALSE, FALSE, FALSE, FALSE) - ), - catchability_ctl = list( - log_q = list( - 0, parfinal$log_q2_mean, - parfinal$log_q3_mean, parfinal$inf1_srv6 - ), - estimate_q = list(FALSE, TRUE, TRUE, TRUE), - random_q = list(FALSE, FALSE, FALSE, FALSE) - ) -) - -# Population module -# recruitment -recruitment <- set_recruitment( - form = "BevertonHoltRecruitment", - initial_values = list( - log_rzero = parfinal$mean_log_recruit + log(1e9), - logit_steep = -log(1.0 - .99999) + log(.99999 - 0.2), - log_sigma_recruit = log(parfinal$sigmaR), - log_devs = parfinal$dev_log_recruit[-1] - ), - is_estimated = list( - log_rzero = TRUE, - logit_steep = FALSE, - log_sigma_recruit = FALSE, - log_devs = TRUE - ), - is_random_effect = list( - log_rzero = FALSE, - logit_steep = FALSE, - log_sigma_recruit = FALSE - ) -) - -## growth -- assumes single WAA vector for everything, based on -## Srv1 above -growth <- set_growth( - data = population_data, - form = "EWAAgrowth", - initial_values = list(weights = pkinput$dat$wt_srv1) -) -## NOTE: FIMS assumes SSB calculated at the start of the year, so -## need to adjust ASAP to do so as well for now, need to make -## timing of SSB calculation part of FIMS later -## maturity -## NOTE: for now tricking FIMS into thinking age 0 is age 1, so need to adjust A50 for maturity because FIMS calculations use ages 0-5+ instead of 1-6 -maturity <- set_maturity( - form = maturity_ctl$form, - initial_values = maturity_ctl$initial_values, - is_estimated = maturity_ctl$is_estimated, - is_random_effect = maturity_ctl$is_random_effect -) - -# population -population <- set_population( - data = population_data, - initial_values = population_initial_values, - is_estimated = population_is_estimated, - maturity = maturity, - growth = growth, - recruitment = recruitment -) - -## make FIMS model -success <- CreateTMBModel() -parameters <- list(p = get_fixed()) -obj4 <- TMB::MakeADFun(data = list(), parameters, DLL = "FIMS", silent = TRUE) -## report values for the two models -rep4 <- obj4$report() - -## Parameters are in a different order but seem to match -opt4 <- with(obj4, nlminb(par, fn, gr)) -clear() -clear_logs() -# rep4 -# rm(list = ls()) - -## Test that the two models are identical -all.equal(rep3, rep4) +# selectivity_double_logistic <- set_selectivity( +# form = "DoubleLogisticSelectivity", +# initial_values = c( +# parfinal$inf1_fsh_mean, exp(parfinal$log_slp1_fsh_mean), +# parfinal$inf2_fsh_mean, exp(parfinal$log_slp2_fsh_mean) +# ), +# is_estimated = rep(TRUE, 4), +# is_random_effect = rep(FALSE, 4) +# ) +# +# selectivity_logistic <- set_selectivity( +# form = "LogisticSelectivity", +# initial_values = c( +# parfinal$inf1_fsh_mean, exp(parfinal$log_slp1_fsh_mean) +# ), +# is_estimated = rep(TRUE, 2), +# is_random_effect = rep(FALSE, 2) +# ) +# +# selectivity <- vector(mode = "list", length = 4) +# selectivity[[1]] <- selectivity[[2]] <- selectivity_double_logistic +# selectivity[[3]] <- selectivity_logistic +# selectivity[[4]] <- selectivity_double_logistic # Order matters because the selectivity modules assign unique IDs. +# +# fleet <- set_fleet( +# data = age_frame, +# is_estimated_obs_error = list(FALSE, FALSE, FALSE, FALSE), +# selectivity_ctl = NULL, +# selectivity_module_list = selectivity, +# Fmort_ctl = list( +# is_survey = list(FALSE, TRUE, TRUE, TRUE), +# estimate_F = list(TRUE, FALSE, FALSE, FALSE), +# random_F = list(FALSE, FALSE, FALSE, FALSE) +# ), +# catchability_ctl = list( +# log_q = list( +# 0, parfinal$log_q2_mean, +# parfinal$log_q3_mean, parfinal$inf1_srv6 +# ), +# estimate_q = list(FALSE, TRUE, TRUE, TRUE), +# random_q = list(FALSE, FALSE, FALSE, FALSE) +# ) +# ) +# +# # Population module +# # recruitment +# recruitment <- set_recruitment( +# form = "BevertonHoltRecruitment", +# initial_values = list( +# log_rzero = parfinal$mean_log_recruit + log(1e9), +# logit_steep = -log(1.0 - .99999) + log(.99999 - 0.2), +# log_sigma_recruit = log(parfinal$sigmaR), +# log_devs = parfinal$dev_log_recruit[-1] +# ), +# is_estimated = list( +# log_rzero = TRUE, +# logit_steep = FALSE, +# log_sigma_recruit = FALSE, +# log_devs = TRUE +# ), +# is_random_effect = list( +# log_rzero = FALSE, +# logit_steep = FALSE, +# log_sigma_recruit = FALSE +# ) +# ) +# +# ## growth -- assumes single WAA vector for everything, based on +# ## Srv1 above +# growth <- set_growth( +# data = population_data, +# form = "EWAAgrowth", +# initial_values = list(weights = pkinput$dat$wt_srv1) +# ) +# ## NOTE: FIMS assumes SSB calculated at the start of the year, so +# ## need to adjust ASAP to do so as well for now, need to make +# ## timing of SSB calculation part of FIMS later +# ## maturity +# ## NOTE: for now tricking FIMS into thinking age 0 is age 1, so need to adjust A50 for maturity because FIMS calculations use ages 0-5+ instead of 1-6 +# maturity <- set_maturity( +# form = maturity_ctl$form, +# initial_values = maturity_ctl$initial_values, +# is_estimated = maturity_ctl$is_estimated, +# is_random_effect = maturity_ctl$is_random_effect +# ) +# +# # population +# population <- set_population( +# data = population_data, +# initial_values = population_initial_values, +# is_estimated = population_is_estimated, +# maturity = maturity, +# growth = growth, +# recruitment = recruitment +# ) +# +# ## make FIMS model +# success <- CreateTMBModel() +# parameters <- list(p = get_fixed()) +# obj4 <- TMB::MakeADFun(data = list(), parameters, DLL = "FIMS", silent = TRUE) +# ## report values for the two models +# rep4 <- obj4$report() +# +# ## Parameters are in a different order but seem to match +# opt4 <- with(obj4, nlminb(par, fn, gr)) +# clear() +# clear_logs() +# # rep4 +# # rm(list = ls()) +# +# ## Test that the two models are identical +# all.equal(rep3, rep4)