Merge branch 'master' of https://github.com/LandSciTech/caribouMetrics

.github/workflows/R-CMD-check.yaml

@@ -18,8 +18,9 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macos-latest,   r: 'release'}
-          - {os: windows-latest, r: 'release'}
+         # JAGS not working for these on GitHub
+          # - {os: macos-latest,   r: 'release'}
+          # - {os: windows-latest, r: 'release'}
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
           - {os: ubuntu-latest,   r: 'oldrel-1'}

NAMESPACE

@@ -56,6 +56,7 @@ importFrom(stats,time)
 importFrom(stats,var)
 importFrom(stats,weighted.mean)
 importFrom(terra,plot)
+importFrom(utils,hasName)
 importFrom(utils,packageVersion)
 importFrom(utils,read.csv)
 importFrom(utils,write.csv)

R/caribouMetrics-package.R

@@ -12,5 +12,6 @@
 #' @importFrom utils read.csv write.csv packageVersion
 #' @importFrom terra plot
 #' @importFrom rlang .data
+#' @importFrom utils hasName
 ## usethis namespace: end
 NULL

R/getScenarioDefaults.R

@@ -25,7 +25,7 @@
 #' @param zMin number in 0, 1. Minimum probability of missing calves in composition survey.
 #' @param zMax number in 0, <1. Maximum probability of missing calves in composition survey.
 #' @param cowMult number >= 1. The apparent number of adult females per collared animal in composition survey. Set to NA to use `cowCount`.
-#' @param collarCount number >= 1. The target number of collars active each year. Set to NA to use `freqStartsPerYear` in `simulateObservations(`
+#' @param collarCount number >= 1. The target number of collars active each year. Set to NA to use `freqStartsPerYear` in `simulateObservations()`
 #' @inheritParams caribouPopGrowth
 #' @inheritParams caribouBayesianPM
 #' @param collarInterval number. Optional. Number of years between collar deployments. If
@@ -56,16 +56,16 @@ getScenarioDefaults <- function(paramTable = NULL,
                          uMin = 0, uMax = 0.2, zMin = 0, zMax = 0.2, cowMult = 6,
                          collarInterval = NA, cowCount = NA, 
                          collarCount = NA, startYear = NA,
-                         interannualVar = formals(caribouPopGrowth)$interannualVar,
+                         interannualVar = list(eval(formals(caribouPopGrowth)$interannualVar)),
                          curYear = 2023) {
   defList <- c(as.list(environment()))
   defList$paramTable <- NULL
   if (is.null(paramTable)) {
-    paramTable <- as.data.frame(defList)
+    paramTable <- as_tibble(defList)
   } else {
     # keep all values in paramTable and add any that are missing using values in
     # defList
-    paramTable <- cbind(paramTable, defList[which(!names(defList) %in% names(paramTable))])
+    paramTable <- bind_cols(paramTable, as_tibble(defList[which(!names(defList) %in% names(paramTable))]))
   }
 
   # remove columns that are all NA because they should be missing and order like
@@ -78,11 +78,13 @@ getScenarioDefaults <- function(paramTable = NULL,
          " but not both.")
   }
 
-  if(sum(paramTable$collarCount>paramTable$N0)>0){
+  if(is.element("cowCount", names(paramTable)) && sum(paramTable$collarCount>paramTable$N0)>0){
     warning("Target number of collars collarCount should not exceed initial population size N0.")
   }
 
-  if(sum(paramTable$collarCount*paramTable$cowMult>paramTable$N0)>0){
+  if(hasName(paramTable, "collarCount") && 
+     hasName(paramTable, "cowMult") && 
+     sum(paramTable$collarCount*paramTable$cowMult>paramTable$N0)>0){
     warning("Set cowMult, collarCount and N0 so the expected number of cows in composition surveys does not exceed initial population size N0.")
   }
 

R/getSimsNational.R

@@ -44,7 +44,8 @@ if(file.exists("inst/extdata/simsNationalRadjusted.rds")){
 getSimsNational <- function(replicates = 1000, N0 = 1000, Anthro = seq(0, 100, by = 1),
                             fire_excl_anthro = 0, useQuantiles  = NULL,
                             populationGrowthTable  = NULL, adjustR = TRUE, 
-                            cPars=getScenarioDefaults(), forceUpdate = F,interannualVar = formals(caribouPopGrowth)$interannualVar) {
+                            cPars=getScenarioDefaults(), forceUpdate = F,
+                            interannualVar = eval(formals(caribouPopGrowth)$interannualVar)) {
   # replicates=1000;N0=1000;Anthro=seq(0,100,by=1);fire_excl_anthro=0;
   # useQuantiles =NULL;adjustR=F;forceUpdate=F
   doSave <- FALSE
@@ -104,7 +105,8 @@ getSimsNational <- function(replicates = 1000, N0 = 1000, Anthro = seq(0, 100, b
   pars <- merge(data.frame(N0 = N0), rateSamplesAll)
   pars <- cbind(pars, caribouPopGrowth(pars$N0, R_bar = pars$R_bar,
                                        S_bar = pars$S_bar, numSteps = cPars$assessmentYrs,
-                                       K = FALSE, adjustR = adjustR, c=pars$c, interannualVar=interannualVar,progress = FALSE))
+                                       K = FALSE, adjustR = adjustR, c = pars$c, 
+                                       interannualVar=interannualVar, progress = FALSE))
   simSurvBig <- pars %>%
     select("Anthro", "S_t") %>%
     group_by(.data$Anthro) %>%

R/simulateObservations.R

@@ -92,12 +92,12 @@ simulateObservations <- function(paramTable, cowCounts = NULL,
     testTable(cowCounts, c("Year", "Count", "Class"),
               req_vals = list(Year = (paramTable$startYear+paramTable$preYears):(paramTable$startYear+paramTable$preYears+paramTable$obsYears-1)),
               acc_vals = list(Class = "cow"))
-  } else if(!is.null(paramTable$cowCount)){
+  } else if(hasName(paramTable, "cowCount")){
     cowCounts <- data.frame(Year = (paramTable$startYear+paramTable$preYears):
                               (paramTable$startYear+paramTable$preYears+paramTable$obsYears-1),
                             Count = paramTable$cowCount,
                             Class = "cow")
-  } else if(is.null(paramTable$cowCount) & is.null(paramTable$cowMult)){
+  } else if(!hasName(paramTable, "cowCount") & !hasName(paramTable, "cowMult")){
     stop("One of cowCounts or paramTable$cowCount must be provided", 
          call. = FALSE)
   }
@@ -148,10 +148,10 @@ simulateObservations <- function(paramTable, cowCounts = NULL,
       sefSlopeMultiplier = paramTable$sSlopeMod, recQuantile = paramTable$rQuantile,
       sefQuantile = paramTable$sQuantile,
       N0 = paramTable$N0, adjustR = paramTable$adjustR,
-      cowMult = ifelse(is.null(paramTable$cowMult), 1, paramTable$cowMult),
+      cowMult = ifelse(!is.element("cowMult", names(paramTable)), 1, paramTable$cowMult),
       qMin = paramTable$qMin, qMax = paramTable$qMax, uMin = paramTable$uMin,
       uMax = paramTable$uMax, zMin = paramTable$zMin, zMax = paramTable$zMax,
-      interannualVar=paramTable$interannualVar
+      interannualVar=paramTable$interannualVar[[1]]
     )
   )