From 533ffc480f2a870ff9dc8c0d7f0ba26d1988bbeb Mon Sep 17 00:00:00 2001 From: adamkucharski Date: Thu, 24 Apr 2025 21:47:39 +0100 Subject: [PATCH 1/3] Update cfr_rolling.R --- R/cfr_rolling.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/cfr_rolling.R b/R/cfr_rolling.R index 6491c258..de615221 100644 --- a/R/cfr_rolling.R +++ b/R/cfr_rolling.R @@ -128,6 +128,9 @@ cfr_rolling <- function(data, call. = FALSE ) } + + # Handle edge cases where p_mid might be NA or Inf + p_mid_values[is.na(p_mid_values) | is.infinite(p_mid_values)] <- 0 # generate series of CFR estimates with expanding time window # Suppress method choice messages to prevent spamming user. From db188dc69c792b8560d8d118c87d1d67b65480b7 Mon Sep 17 00:00:00 2001 From: adamkucharski Date: Thu, 24 Apr 2025 22:13:13 +0100 Subject: [PATCH 2/3] Fix conditional bug --- R/cfr_rolling.R | 6 +++--- R/estimate_severity.R | 17 ++++++++--------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/R/cfr_rolling.R b/R/cfr_rolling.R index de615221..7300748f 100644 --- a/R/cfr_rolling.R +++ b/R/cfr_rolling.R @@ -120,6 +120,9 @@ cfr_rolling <- function(data, # NOTE: choosing message rather than warning, as warnings are nearly # guaranteed in the early stages of an outbreak due to poor data p_mid_values <- cumulative_deaths / round(cumulative_outcomes) + + # Handle edge cases where p_mid might be NA or Inf + p_mid_values[is.na(p_mid_values) | is.infinite(p_mid_values)] <- 0 if (any(is.infinite(p_mid_values) | p_mid_values < 1e-4)) { message( @@ -128,9 +131,6 @@ cfr_rolling <- function(data, call. = FALSE ) } - - # Handle edge cases where p_mid might be NA or Inf - p_mid_values[is.na(p_mid_values) | is.infinite(p_mid_values)] <- 0 # generate series of CFR estimates with expanding time window # Suppress method choice messages to prevent spamming user. diff --git a/R/estimate_severity.R b/R/estimate_severity.R index f2bfdbfd..7f6210e8 100644 --- a/R/estimate_severity.R +++ b/R/estimate_severity.R @@ -133,17 +133,16 @@ .select_func_likelihood <- function(total_cases, poisson_threshold, p_mid) { # 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)) { - func_likelihood <- function(total_outcomes, total_deaths, pp) { - lchoose(round(total_outcomes), total_deaths) + - (total_deaths * log(pp)) + - (((total_outcomes) - total_deaths) * log(1.0 - pp)) - } + + # Default to binomial likelihood + func_likelihood <- function(total_outcomes, total_deaths, pp) { + lchoose(round(total_outcomes), total_deaths) + + (total_deaths * log(pp)) + + (((total_outcomes) - total_deaths) * log(1.0 - pp)) } - # Poisson approx - if ((total_cases >= poisson_threshold) && (p_mid < 0.05)) { + # Poisson approx - only switch to Poisson if conditions are met + if ((total_cases >= poisson_threshold) && (!is.na(p_mid)) && (p_mid < 0.05)) { func_likelihood <- function(total_outcomes, total_deaths, pp) { stats::dpois( total_deaths, pp * round(total_outcomes), From aaa835eef540b47106324068b5cd15ca06f907d4 Mon Sep 17 00:00:00 2001 From: adamkucharski Date: Thu, 24 Apr 2025 22:22:36 +0100 Subject: [PATCH 3/3] Fix linting --- R/cfr_rolling.R | 2 +- R/estimate_severity.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/cfr_rolling.R b/R/cfr_rolling.R index 7300748f..e67b848c 100644 --- a/R/cfr_rolling.R +++ b/R/cfr_rolling.R @@ -120,7 +120,7 @@ cfr_rolling <- function(data, # NOTE: choosing message rather than warning, as warnings are nearly # guaranteed in the early stages of an outbreak due to poor data p_mid_values <- cumulative_deaths / round(cumulative_outcomes) - + # Handle edge cases where p_mid might be NA or Inf p_mid_values[is.na(p_mid_values) | is.infinite(p_mid_values)] <- 0 diff --git a/R/estimate_severity.R b/R/estimate_severity.R index 7f6210e8..b310876e 100644 --- a/R/estimate_severity.R +++ b/R/estimate_severity.R @@ -133,7 +133,7 @@ .select_func_likelihood <- function(total_cases, poisson_threshold, p_mid) { # NOTE: internal function is not input checked # switch likelihood function based on total cases and p_mid - + # Default to binomial likelihood func_likelihood <- function(total_outcomes, total_deaths, pp) { lchoose(round(total_outcomes), total_deaths) +