From 2330aba298d046bf74f5f2a7e7c42299f610699c Mon Sep 17 00:00:00 2001 From: Seb Dalgarno Date: Tue, 30 Apr 2024 13:47:08 -0700 Subject: [PATCH] change yearling_female_proportion to sex_ratio this is now sex_ratio in fit and predict funs fixes #61, fixes #46 --- R/fit-recruitment.R | 16 ++++++++++------ R/model-recruitment.R | 8 ++++---- R/params.R | 1 - man/bb_fit_recruitment.Rd | 5 +++-- man/bb_fit_recruitment_ml.Rd | 5 +++-- man/model_recruitment.Rd | 4 ++-- man/params.Rd | 2 -- tests/testthat/test-zzzfit-recruitment-ml.R | 6 +++--- tests/testthat/test-zzzfit-recruitment.R | 6 +++--- vignettes/bboutools.Rmd | 4 +++- 10 files changed, 31 insertions(+), 26 deletions(-) diff --git a/R/fit-recruitment.R b/R/fit-recruitment.R index 7affedd..544404b 100644 --- a/R/fit-recruitment.R +++ b/R/fit-recruitment.R @@ -28,6 +28,8 @@ #' The start month of the Caribou year can be adjusted with `year_start`. #' #' @inheritParams params +#' @param sex_ratio A number between 0 and 1 of the proportion of females at birth. +#' This proportion is applied to yearlings. #' @return A list of the Nimble model object, data and mcmcr samples. #' @export #' @family model @@ -38,7 +40,7 @@ bb_fit_recruitment <- function( data, adult_female_proportion = 0.65, - yearling_female_proportion = 0.5, + sex_ratio = 0.5, min_random_year = 5, year_trend = FALSE, year_start = 4L, @@ -49,7 +51,7 @@ bb_fit_recruitment <- function( chk_data(data) bbd_chk_data_recruitment(data) chk_null_or(adult_female_proportion, vld = vld_range) - chk_range(yearling_female_proportion) + chk_range(sex_ratio) chk_whole_number(min_random_year) chk_gte(min_random_year) chk_flag(year_trend) @@ -75,7 +77,7 @@ bb_fit_recruitment <- function( year_random = year_random, year_trend = year_trend, adult_female_proportion = adult_female_proportion, - yearling_female_proportion = yearling_female_proportion, + sex_ratio = sex_ratio, demographic_stochasticity = TRUE, priors = priors ) @@ -123,6 +125,8 @@ bb_fit_recruitment <- function( #' The start month of the Caribou year can be adjusted with `year_start`. #' #' @inheritParams params +#' @param sex_ratio A number between 0 and 1 of the proportion of females at birth. +#' This proportion is applied to yearlings. #' @return A list of the Nimble model object and Maximum Likelihood output with estimates and standard errors on the transformed scale. #' @export #' @family model @@ -133,7 +137,7 @@ bb_fit_recruitment <- function( bb_fit_recruitment_ml <- function( data, adult_female_proportion = 0.65, - yearling_female_proportion = 0.5, + sex_ratio = 0.5, min_random_year = 5, year_trend = FALSE, year_start = 4L, @@ -142,7 +146,7 @@ bb_fit_recruitment_ml <- function( chk_data(data) bbd_chk_data_recruitment(data) chk_null_or(adult_female_proportion, vld = vld_range) - chk_range(yearling_female_proportion) + chk_range(sex_ratio) chk_whole_number(min_random_year) chk_gte(min_random_year) chk_flag(year_trend) @@ -163,7 +167,7 @@ bb_fit_recruitment_ml <- function( year_random = year_random, year_trend = year_trend, adult_female_proportion = adult_female_proportion, - yearling_female_proportion = yearling_female_proportion, + sex_ratio = sex_ratio, demographic_stochasticity = FALSE, # not actually used for ML priors = priors_recruitment() diff --git a/R/model-recruitment.R b/R/model-recruitment.R index 22e566f..11fe2f1 100644 --- a/R/model-recruitment.R +++ b/R/model-recruitment.R @@ -34,7 +34,7 @@ model_recruitment <- year_random = TRUE, year_trend = TRUE, adult_female_proportion = 0.65, - yearling_female_proportion = 0.5, + sex_ratio = 0.5, demographic_stochasticity = TRUE, priors = NULL) { constants <- list( @@ -46,7 +46,7 @@ model_recruitment <- bAnnual_sd = priors[["bAnnual_sd"]], adult_female_proportion_alpha = priors[["adult_female_proportion_alpha"]], adult_female_proportion_beta = priors[["adult_female_proportion_beta"]], - yearling_female_proportion = yearling_female_proportion, + sex_ratio = sex_ratio, year_random = year_random, year_trend = year_trend, fixed_proportion = !is.null(adult_female_proportion), @@ -106,12 +106,12 @@ model_recruitment <- if (demographic_stochasticity) { for (i in 1:nObs) { - FemaleYearlings[i] ~ dbin(yearling_female_proportion, Yearlings[i]) + FemaleYearlings[i] ~ dbin(sex_ratio, Yearlings[i]) OtherAdultsFemales[i] ~ dbin(adult_female_proportion, UnknownAdults[i]) } } else { for (i in 1:nObs) { - FemaleYearlings[i] <- round(yearling_female_proportion * Yearlings[i]) + FemaleYearlings[i] <- round(sex_ratio * Yearlings[i]) OtherAdultsFemales[i] <- round(adult_female_proportion * UnknownAdults[i]) } diff --git a/R/params.R b/R/params.R index e91e956..35e3933 100644 --- a/R/params.R +++ b/R/params.R @@ -28,7 +28,6 @@ #' @param year_trend A flag indicating whether to fit a year trend effect. #' Year trend cannot be fit if there is also a fixed year effect (as opposed to random effect). #' @param include_uncertain_morts A flag indicating whether to include uncertain mortalities in total mortalities. -#' @param yearling_female_proportion A number between 0 and 1 of the expected proportion of yearlings that are female. #' @param adult_female_proportion A number between 0 and 1 of the expected proportion of adults that are female. #' If NULL, the proportion is estimated from the data (i.e., `Cows ~ Binomial(adult_female_proportion, Cows + Bulls)`) and a prior of dbeta(65, 35) is used. #' This prior can be changed via the `priors` argument. diff --git a/man/bb_fit_recruitment.Rd b/man/bb_fit_recruitment.Rd index 72c2448..9f360b4 100644 --- a/man/bb_fit_recruitment.Rd +++ b/man/bb_fit_recruitment.Rd @@ -7,7 +7,7 @@ bb_fit_recruitment( data, adult_female_proportion = 0.65, - yearling_female_proportion = 0.5, + sex_ratio = 0.5, min_random_year = 5, year_trend = FALSE, year_start = 4L, @@ -24,7 +24,8 @@ bb_fit_recruitment( If NULL, the proportion is estimated from the data (i.e., \code{Cows ~ Binomial(adult_female_proportion, Cows + Bulls)}) and a prior of dbeta(65, 35) is used. This prior can be changed via the \code{priors} argument.} -\item{yearling_female_proportion}{A number between 0 and 1 of the expected proportion of yearlings that are female.} +\item{sex_ratio}{A number between 0 and 1 of the proportion of females at birth. +This proportion is applied to yearlings.} \item{min_random_year}{A whole number of the minimum number of years required to fit year as a random effect (as opposed to a fixed effect).} diff --git a/man/bb_fit_recruitment_ml.Rd b/man/bb_fit_recruitment_ml.Rd index ae454af..12cec35 100644 --- a/man/bb_fit_recruitment_ml.Rd +++ b/man/bb_fit_recruitment_ml.Rd @@ -7,7 +7,7 @@ bb_fit_recruitment_ml( data, adult_female_proportion = 0.65, - yearling_female_proportion = 0.5, + sex_ratio = 0.5, min_random_year = 5, year_trend = FALSE, year_start = 4L, @@ -22,7 +22,8 @@ bb_fit_recruitment_ml( If NULL, the proportion is estimated from the data (i.e., \code{Cows ~ Binomial(adult_female_proportion, Cows + Bulls)}) and a prior of dbeta(65, 35) is used. This prior can be changed via the \code{priors} argument.} -\item{yearling_female_proportion}{A number between 0 and 1 of the expected proportion of yearlings that are female.} +\item{sex_ratio}{A number between 0 and 1 of the proportion of females at birth. +This proportion is applied to yearlings.} \item{min_random_year}{A whole number of the minimum number of years required to fit year as a random effect (as opposed to a fixed effect).} diff --git a/man/model_recruitment.Rd b/man/model_recruitment.Rd index 8d19048..6671f90 100644 --- a/man/model_recruitment.Rd +++ b/man/model_recruitment.Rd @@ -9,7 +9,7 @@ model_recruitment( year_random = TRUE, year_trend = TRUE, adult_female_proportion = 0.65, - yearling_female_proportion = 0.5, + sex_ratio = 0.5, demographic_stochasticity = TRUE, priors = NULL ) @@ -26,7 +26,7 @@ Year trend cannot be fit if there is also a fixed year effect (as opposed to ran If NULL, the proportion is estimated from the data (i.e., \code{Cows ~ Binomial(adult_female_proportion, Cows + Bulls)}) and a prior of dbeta(65, 35) is used. This prior can be changed via the \code{priors} argument.} -\item{yearling_female_proportion}{A number between 0 and 1 of the expected proportion of yearlings that are female.} +\item{sex_ratio}{A number between 0 and 1 of the proportion of females at birth.} \item{demographic_stochasticity}{A flag indicating whether to include demographic_stochasticity in the recruitment model.} diff --git a/man/params.Rd b/man/params.Rd index 09ea74e..f33c1c8 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -27,8 +27,6 @@ Year trend cannot be fit if there is also a fixed year effect (as opposed to ran \item{include_uncertain_morts}{A flag indicating whether to include uncertain mortalities in total mortalities.} -\item{yearling_female_proportion}{A number between 0 and 1 of the expected proportion of yearlings that are female.} - \item{adult_female_proportion}{A number between 0 and 1 of the expected proportion of adults that are female. If NULL, the proportion is estimated from the data (i.e., \code{Cows ~ Binomial(adult_female_proportion, Cows + Bulls)}) and a prior of dbeta(65, 35) is used. This prior can be changed via the \code{priors} argument.} diff --git a/tests/testthat/test-zzzfit-recruitment-ml.R b/tests/testthat/test-zzzfit-recruitment-ml.R index 3bcf77c..f5a96f2 100644 --- a/tests/testthat/test-zzzfit-recruitment-ml.R +++ b/tests/testthat/test-zzzfit-recruitment-ml.R @@ -70,7 +70,7 @@ test_that("can change fixed adult_female_proportion", { expect_snapshot_data(coef(fit), "fixed_adult_female_proportion") }) -test_that("can change fixed yearling_female_proportion", { +test_that("can change fixed sex_ratio", { skip_on_ci() skip_on_covr() @@ -78,7 +78,7 @@ test_that("can change fixed yearling_female_proportion", { x$Yearlings[5:10] <- 1 fit <- bb_fit_recruitment_ml( data = x, - yearling_female_proportion = 0.2, + sex_ratio = 0.2, quiet = TRUE ) @@ -87,7 +87,7 @@ test_that("can change fixed yearling_female_proportion", { expect_s4_class(fit$summary, "AGHQuad_summary") expect_s4_class(fit$mle, "OptimResultNimbleList") expect_setequal(pars(fit), c("b0", "bAnnual", "sAnnual")) - expect_snapshot_data(coef(fit), "fixed_yearling_female_proportion") + expect_snapshot_data(coef(fit), "fixed_sex_ratio") }) test_that("can estimate adult_female_proportion", { diff --git a/tests/testthat/test-zzzfit-recruitment.R b/tests/testthat/test-zzzfit-recruitment.R index 18832ce..172dd8d 100644 --- a/tests/testthat/test-zzzfit-recruitment.R +++ b/tests/testthat/test-zzzfit-recruitment.R @@ -133,7 +133,7 @@ test_that("can estimate adult_female_proportion", { expect_snapshot_data(coef(fit), "estimate_adult_female_proportion") }) -test_that("can change fixed yearling_female_proportion", { +test_that("can change fixed sex_ratio", { skip_on_covr() x <- bboudata::bbourecruit_a @@ -141,7 +141,7 @@ test_that("can change fixed yearling_female_proportion", { set.seed(101) fit <- bb_fit_recruitment( data = x, nthin = 1, niters = 100, - yearling_female_proportion = 0.2, + sex_ratio = 0.2, quiet = TRUE ) @@ -151,7 +151,7 @@ test_that("can change fixed yearling_female_proportion", { expect_s3_class(fit$samples, "mcmcr") expect_s3_class(fit$data, "data.frame") expect_setequal(pars(fit), c("b0", "bAnnual", "sAnnual")) - expect_snapshot_data(coef(fit), "yearling_female_proportion") + expect_snapshot_data(coef(fit), "sex_ratio") }) test_that("can set priors", { diff --git a/vignettes/bboutools.Rmd b/vignettes/bboutools.Rmd index bdbf972..5282491 100644 --- a/vignettes/bboutools.Rmd +++ b/vignettes/bboutools.Rmd @@ -124,7 +124,7 @@ If `adult_female_proportion = NULL`, the adult female proportion is estimated fr By default, a biologically informative prior of `Beta(65,35)` is used. This corresponds to an expected value of 65%. -The yearling female proportion can be set with `yearling_female_proportion`. +The yearling and calf female proportion can be set with `sex_ratio`. The default value is 0.5. The model can be fit with random effect of year, fixed effect of year and/or continuous effect of year (i.e., year trend). @@ -225,6 +225,8 @@ See the 'analytical methods' article for details. Predictions of calf-cow ratio can also be made using `bb_predict_calf_cow_ratio()`. +The sex ratio can be adjusted with `sex_ratio`. + #### Recruitment by year ```{r} predict_recruitment <- bb_predict_recruitment(recruitment, year = TRUE)