nmode's Git Repositories - Rnaught/blob - R/WP.R

   1 #' WP method
   2 #'
   3 #' This function implements an R0 estimation due to White and Pagano (Statistics in Medicine, 2008).
   4 #' The method is based on maximum likelihood estimation in a Poisson transmission model.
   5 #' See details for important implementation notes.
   6 #'
   7 #' This method is based on a Poisson transmission model, and hence may be most most valid at the beginning
   8 #' of an epidemic. In their model, the serial distribution is assumed to be discrete with a finite number
   9 #' of posible values. In this implementation, if the serial distribution is assumed known, it is taken to
  10 #' be a discretized version of a gamma distribution with mean \code{mu}, shape parameter one, and largest
  11 #' possible value based on parameter \code{tol}. When the serial distribution is unknown, the function
  12 #' implements a grid search algorithm to find the maximum likelihood estimator over all possible gamma
  13 #' distributions with unknown mean and variance, restricting these to a prespecified grid (see
  14 #' \code{search} parameter).
  15 #'
  16 #' When the serial distribution is taken to be \code{known}, sensitivity testing of the parameter \code{mu}
  17 #' is strongly recommended. If the serial distribution is \code{unknown}, the likelihood function can be
  18 #' flat near the maximum, resulting in numerical instability of the optimizer.  When the serial distribution
  19 #' is \code{unkown} the implementation takes considerably longer to run.  Users should be careful about units
  20 #' of time (e.g. are counts observed daily or weekly?) when implementing.
  21 #'
  22 #' The model developed in White and Pagano (2008) is discrete, and hence the serial distribution is finite
  23 #' discrete. In our implementation, the input value \code{mu} is that of a continuous distribution. The
  24 #' algorithm when \code{method="known"} disretizes this input, and hence the mean of the serial distribution
  25 #' returned in the list \code{SD} will differ from \code{mu} somewhat. That is to say, if the user notices that
  26 #' the input \code{mu} and out put mean of \code{SD} are different, this is to be expected, and is caused by
  27 #' the discretization.
  28 #'
  29 #' @param NT Vector of case counts
  30 #' @param mu Mean of the serial distribution (needs to match case counts in time units; for example, if case
  31 #'           counts are weekly and the serial distribution has a mean of seven days, then \code{mu} should be
  32 #'           set to one). The default value of \code{mu} is set to \code{NA}.
  33 #' @param method Variable taking one of two possible values: \code{known} or \code{unknown}. If "known", the
  34 #'               serial distribution is assumed to be gamma with  rate 1/\code{mu} and shape equal to one, if
  35 #'               "unknown" then the serial distribution is gamma with unknown parameters. Defaults to "unknown"
  36 #' @param search List of default values for the grid search algorithm; the list includes three elements: the
  37 #'               first is \code{B} which is the length of the grid in one dimension, the second is
  38 #'               \code{scale.max} which is the largest possible value of the scale parameter, and the third is
  39 #'               \code{shape.max} which is the largest possible value of the shape parameter; defaults to
  40 #'               \code{B=100, scale.max=10, shape.max=10}. For both shape and scale, the smallest possible
  41 #'               value is 1/\code{B}.
  42 #' @param tol Cutoff value for cumulative distribution function of the pre-discretization gamma serial
  43 #'            distribution, defaults to 0.999 (i.e. in the discretization, the maximum is chosen such that the
  44 #'            original gamma distribution has cumulative probability of no more than 0.999 at this maximum).
  45 #'
  46 #' @return WP returns a list containing the following components:  \code{Rhat} is the estimate of R0, \code{SD}
  47 #'            is either the discretized serial distribution (if \code{method="known"}) or the estimated
  48 #'            discretized serial distribution (if \code{method="unknown"}), and \code{inputs} is a list of the
  49 #'            original input variables \code{NT, mu, method, search, tol}. The list also returns the variable
  50 #'            \code{check}, which is equal to the number of non-unique maximum likelihood estimators. The serial
  51 #'            distribution \code{SD} is returned as a list made up of \code{supp} the support of the distribution
  52 #'            and \code{pmf} the probability mass function.
  53 #'
  54 #' @examples
  55 #' ## ===================================================== ##
  56 #' ## Illustrate on weekly data                             ##
  57 #' ## ===================================================== ##
  58 #'
  59 #' NT <- c(1, 4, 10, 5, 3, 4, 19, 3, 3, 14, 4)
  60 #' ## obtain Rhat when serial distribution has mean of five days
  61 #' res1 <- WP(NT=NT, mu=5/7, method="known")
  62 #' res1$Rhat
  63 #' ## obtain Rhat when serial distribution has mean of three days
  64 #' res2 <- WP(NT=NT, mu=3/7, method="known")
  65 #' res2$Rhat
  66 #' ## obtain Rhat when serial distribution is unknown
  67 #' ## NOTE:  this implementation will take longer to run
  68 #' res3 <- WP(NT=NT)
  69 #' res3$Rhat
  70 #' ## find mean of estimated serial distribution
  71 #' serial       <-      res3$SD
  72 #' sum(serial$supp*serial$pmf)
  73 #'
  74 #' ## ========================================================= ##
  75 #' ## Compute Rhat using only the first five weeks of data      ##
  76 #' ## ========================================================= ##
  77 #'
  78 #' res4 <- WP(NT=NT[1:5], mu=5/7, method="known")       # serial distribution has mean of five days
  79 #' res4$Rhat
  80 #'
  81 #' @export
  82 WP <- function(NT, mu="NA", method="unknown", search=list(B=100, shape.max=10, scale.max=10), tol=0.999) {
  83     if (method == "unknown") {
  84         print("You have assumed that the serial distribution is unknown.")
  85         res <- WP_unknown(NT=NT, B=search$B, shape.max=search$shape.max, scale.max=search$scale.max, tol=tol)
  86         Rhat <- res$Rhat
  87         p <- res$p
  88         range.max <- res$range.max
  89         JJ <- res$JJ
  90     }
  91
  92         if (method == "known") {
  93         if (mu=="NA") {
  94             res <- "NA"
  95             print("For method=known, the mean of the serial distribution must be specified.")
  96         } else {
  97             print("You have assumed that the serial distribution is known.")
  98             range.max <- ceiling(qexp(tol, rate=1/mu))
  99             p <- diff(pexp(0:range.max, 1/mu))
 100             p <- p / sum(p)
 101             res <- WP_known(NT=NT, p=p)
 102             Rhat <- res$Rhat
 103             JJ <- NA
 104         }
 105     }
 106
 107     return(list(Rhat=Rhat, check=length(JJ), SD=list(supp=1:range.max, pmf=p), inputs=list(NT=NT, mu=mu, method=method, search=search, tol=tol)))
 108 }