Merge pull request #62 from poissonconsulting/sex_ratio

change yearling_female_proportion to sex_ratio

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()

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])
         }

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.

tests/testthat/test-zzzfit-recruitment-ml.R

@@ -70,15 +70,15 @@ 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()
 
   x <- bboudata::bbourecruit_a
   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", {

tests/testthat/test-zzzfit-recruitment.R

@@ -133,15 +133,15 @@ 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
   x$Yearlings[5:10] <- 1
   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", {

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)