Descriptio et al

Author: Leo Bastos

DESCRIPTION

@@ -1,8 +1,10 @@
 Package: nowcaster
 Title: Nowcaster
-Version: 0.3.3
+Version: 1.0.0
 Authors@R: c(
-    person("Rafael", "Lopes", , "rafael.lp.silva@unesp.br", role = c("aut", "cre"), 
+    person("Rafael", "Lopes", , "rafael.lopes@yale.edu", role = c("aut", "cre"), 
+    comment = c(ORCID = "0000-0002-9416-6145")),
+    person("Tatiana", "Portella", , "tatiana.portella@fiocruz.br", role = c("aut"), 
     comment = c(ORCID = "0000-0002-9416-6145")),
     person("Leonardo", "Bastos", , "leonardo.bastos@fiocruz.br", role = c("aut"), 
     comment = c(ORCID = "0000-0002-1406-0122")))

R/data_w.R

@@ -13,11 +13,12 @@
 #' @param use.epiweek If TRUE, it uses the CDC epiweek definition where the week starts on Sunday, if FALSE it the week ends at the weekday of the last record date.
 #' @param K How much weeks to forecast ahead?
 #' [Default] K is 0, no forecasting ahead
+#' @param silent [Deprecated] to be removed.
 #'
 #' @return Data in weeks format, with the maximum dates for the last week used
 #' @export
 #'
-#' @examples If the last data is at a Sunday, so the weel starts at Monday before.
+#' @examples If the last data is at a Sunday, so the week starts at Monday before.
 #' If ends at Thursday, so it starts on the Friday before
 data.w <- function(dataset,
                    trim.data,

R/data_w_no_age.R

@@ -11,6 +11,7 @@
 #' @param use.epiweek If TRUE, it uses the CDC epiweek definition where the week starts on Sunday, if FALSE it the week ends at the weekday of the last record date.
 #' @param K How much weeks to forecast ahead?
 #' [Default] K is 0, no forecasting ahead
+#' @param silent [Deprecated] to be removed.
 #'
 #' @return Data in weeks format, with the maximum dates for the last week used
 #' @export

R/nowcasting.summary.R

@@ -13,9 +13,9 @@
 #' 'LSb' upper limit, 50% CI
 #' 'LIb' lower limit, 50% CI
 #' @export
-nowcasting.summary <- function(trajetory, age = F){
+nowcasting.summary <- function(trajectory, age = F){
 
-  total.summy <- trajetory |>
+  total.summy <- trajectory |>
     dplyr::group_by(Time, dt_event, sample) |>
     dplyr::summarise(Y = sum(Y, na.rm = T)) |>
     dplyr::group_by(Time, dt_event) |>
@@ -26,7 +26,7 @@ nowcasting.summary <- function(trajetory, age = F){
                      LSb = stats::quantile(Y, probs = 0.75, na.rm = T),
                      .groups = "drop")
   if(age){
-    age.summy <- trajetory |>
+    age.summy <- trajectory |>
       dplyr::group_by(Time, dt_event, fx_etaria, fx_etaria.num) |>
       dplyr::summarise(Median = stats::median(Y, na.rm = T),
                        LI = stats::quantile(Y, probs = 0.025, na.rm = T),

R/nowcasting_age.R

@@ -6,6 +6,7 @@
 #' @param dataset data pre formatted in to age classes and delays by week for each cases, delay triangle format
 #' @param timeREmodel Latent model for time random effects.
 #' [Default] is a second-order random walk model.
+#' @param zero_inflated [Experimental] It deals with zero-inflated data by using a zeroinflatednbinomial2 model.
 #' @param INLAoutput return the INLA output. [Default] is FALSE.
 #' @param INLAoutputOnly return the only the INLA output. [Default] is FALSE.
 #' @param WAIC return the WAIC. [Default] is FALSE.
@@ -24,8 +25,8 @@ nowcasting_age <- function(dataset,
     family <- "zeroinflatednbinomial2"
     control.family <- list(
       hyper = list("theta1" = list(prior = "loggamma",
-                                   param = c(0.01, 0.01)),
-                   # INLA defaulf fro a
+                                   param = c(0.001, 0.001)),
+                   # INLA default fro a
                    "theta2" = list(prior = "gaussian",
                                    param = c(2, 1)))
     )
@@ -86,7 +87,9 @@ nowcasting_age <- function(dataset,
     vector.samples0 <- lapply(X = srag.samples0.list,
                               FUN = function(x, idx = index.missing){
                                 if(zero_inflated){
-                                  unif.log <- as.numeric(stats::runif(idx,0,1) < x$hyperpar[2])
+                                  # unif.log <- as.numeric(stats::runif(idx,0,1) < x$hyperpar[2])
+                                  # p = 1 - (exp(eta) / (1+exp(eta)))^a ; eta -> grande; p -> 0
+                                  unif.log <- as.numeric(stats::runif(idx,0,1) > 1-(exp(x$latent[idx]) / (1+exp(x$latent[idx])))^x$hyperpar[2])
                                 }else{
                                   unif.log = 1
                                 }

R/sragBH.r

@@ -8,7 +8,6 @@
 #' \describe{
 #'   \item{DT_SIN_PRI}{Date of onset symptoms.}
 #'   \item{DT_DIGITA}{Date of recording.}
-#'   \item{DT_SIN_PRI}{Date of onset symptoms.}
 #'   \item{CLASSI_FIN}{Final classification of the case. (Not used for nowcasting)}
 #'   \item{EVOLUCAO}{Case evolution. (Not used for nowcasting)}
 #'   \item{CO_MUN_RES}{IBGE municipality code. Belo Horizonte is 310620.}