Update tests and linting

R/estimate_severity.R

@@ -30,9 +30,8 @@
 #' the estimate and confidence intervals cannot be calculated and the output
 #' `<data.frame>` contains only `NA`s.
 #'
-#' - When `total_outcomes <= total_deaths`, the confidence intervals cannot be 
-#' reliably calculated and are returned as `NA`. The severity estimate is returned
-#' as `0.999`.
+#' - When `total_outcomes <= total_deaths`, the estimate and confidence intervals
+#' cannot be reliably calculated and are returned as `NA`.
 .estimate_severity <- function(total_cases,
                                total_deaths,
                                total_outcomes,
@@ -63,27 +62,31 @@
   # maximum likelihood estimation for corrected severity
   # using increments of 0.1% severity
   pprange <- seq(from = 1e-4, to = 1.0, by = 1e-4)
-  
+
   # if more expected outcomes than observed deaths, set outcomes equal to deaths
-  if(total_outcomes>total_deaths){
-    total_outcomes_checked <- total_outcomes
-    }else{
-      total_outcomes_checked <- total_deaths
+  if (total_outcomes >= total_deaths){
+      total_outcomes_checked <- total_outcomes }else{ 
+      total_outcomes_checked <- NA
       message(
         "Total deaths = ", total_deaths,
         " and expected outcomes = ", round(total_outcomes),
-        " so setting expected outcomes = total deaths. Note: CI output will be NA under this assumption."
+        " so setting expected outcomes = NA. If we were to assume 
+        total deaths = expected outcomes, it would produce an estimate of 1."
       )
     }
 
   # get likelihoods using selected function
   lik <- func_likelihood(total_outcomes_checked, total_deaths, pprange)
 
   # maximum likelihood estimate - if this is empty, return NA
+  # Otherwise return 95% confidence interval of likelihood
   severity_estimate <- pprange[which.max(lik)]
-
-  # 95% confidence interval of likelihood
-  severity_lims <- range(pprange[lik >= (max(lik) - 1.92)])
+  if (length(severity_estimate)==0){
+    severity_estimate <- NA
+    severity_lims <- c(NA,NA) }else{
+    severity_lims <- range(pprange[lik >= 
+                                     (max(lik,na.rm = TRUE) - 1.92)],na.rm = TRUE)
+  }
 
   # return a vector for easy conversion to data
   severity_estimate <- c(severity_estimate, severity_lims)
@@ -126,7 +129,7 @@
   # NOTE: internal function is not input checked
   # switch likelihood function based on total cases and p_mid
   # Binomial approx
-  if (total_cases < poisson_threshold  | (p_mid >= 0.05)) {
+  if (total_cases < poisson_threshold  || (p_mid >= 0.05)) {
     func_likelihood <- function(total_outcomes, total_deaths, pp) {
       lchoose(round(total_outcomes), total_deaths) +
         (total_deaths * log(pp)) +

tests/testthat/_snaps/estimate_ascertainment.md

@@ -11,20 +11,16 @@
     Code
       estimate_ascertainment(data = ebola1976, delay_density = function(x) dgamma(x,
         shape = 2.4, scale = 3.33), severity_baseline = 0.7)
-    Message
-      Total cases = 245 and p = 0.959: using Normal approximation to binomial likelihood.
     Output
         ascertainment_estimate ascertainment_low ascertainment_high
-      1              0.7185383         0.7087172          0.8377214
+      1              0.7297748         0.7147963          0.7530931
 
 # Static ascertainment from vignette
 
     Code
       estimate_ascertainment(data = covid_uk, delay_density = function(x) dlnorm(x,
         meanlog = 2.577, sdlog = 0.44), severity_baseline = 0.014)
-    Message
-      Total cases = 283420 and p = 0.206: using Normal approximation to binomial likelihood.
     Output
         ascertainment_estimate ascertainment_low ascertainment_high
-      1             0.09810792        0.02316347          0.2167183
+      1             0.06779661        0.06734007         0.06829268
 

tests/testthat/_snaps/estimate_severity.md

@@ -4,7 +4,7 @@
       severity_estimate
     Output
       severity_estimate      severity_low     severity_high 
-                 0.9742            0.8356            0.9877 
+                 0.9592            0.9295            0.9793 
 
 ---
 

tests/testthat/_snaps/estimate_static.md

@@ -12,5 +12,5 @@
       scfr_corrected
     Output
         severity_estimate severity_low severity_high
-      1            0.9742       0.8356        0.9877
+      1            0.9592       0.9295        0.9793
 

tests/testthat/test-estimate_ascertainment.R

@@ -95,7 +95,7 @@ test_that("Ascertainment > 1.0 throws a warning", {
     estimate_ascertainment(
       data = ebola1976,
       delay_density = function(x) dgamma(x, shape = 2.40, scale = 3.33),
-      severity_baseline = 0.9
+      severity_baseline = 0.99
     ),
     regexp = "Ascertainment ratios > 1.0 detected, setting these values to 1.0"
   )

tests/testthat/test-estimate_severity.R

@@ -131,22 +131,9 @@ test_that("Special cases of `.estimate_severity()`", {
       poisson_threshold = 100
     ),
     c(
-      severity_estimate = 1e-4, # lowest possible severity under this method
-      severity_low = NA_real_,
-      severity_high = NA_real_
-    )
-  )
-
-  total_outcomes <- 99
-  expect_identical(
-    .estimate_severity(
-      total_cases, total_deaths, total_outcomes,
-      poisson_threshold = 100
-    ),
-    c(
-      severity_estimate = 1 - 1e-4, # highest possible severity
-      severity_low = NA_real_,
-      severity_high = NA_real_
+      severity_estimate = NA, # set NA because not valid calculation
+      severity_low = NA,
+      severity_high = NA
     )
   )