Add discrete Weibull

DESCRIPTION

@@ -3,15 +3,16 @@ Type: Package
 Title: Extensions to endemic-epidemic timeseries modeling from package surveillance
 Version: 0.0.0.0.9014
 Author: Johannes Bracher [aut, cre], the authors and contributors of the surveillance package, https://cran.r-project.org/package=surveillance [ctb] (substantial parts of the package consist of modified code from the surveillance package), R Core Team [ctb] (a few code segments are modified versions of code from base R)
-Maintainer: Johannes Bracher <johannes.bracher@uzh.ch>
+Maintainer: Johannes Bracher <johannes.bracher@kit.edu>
 Description: Extending surveillance::hhh4 to allow for distributed lags, solutions for longterm prediction and (periodically) stationary moments.
 License: GPL-2
 Encoding: UTF-8
 LazyData: true
 Depends: R (>= 3.2.0), methods, grDevices, graphics, stats, utils, sp
         (>= 1.0-15), xtable (>= 1.7-0), polyCub (>= 0.4-3), surveillance
 Imports: surveillance, fanplot, MASS, Matrix, nlme, spatstat,
-    numDeriv
+    numDeriv, Rdpack
+RdMacros: Rdpack
 RoxygenNote: 7.1.1
 Suggests: knitr,
     rmarkdown

NAMESPACE

@@ -32,6 +32,9 @@ export(profile_par_lag)
 export(psi2size.hhh4lag)
 export(stationary_moments)
 export(unrestricted_lag)
+export(weibull_lag)
+importFrom(DiscreteWeibull,ddweibull)
+importFrom(Rdpack,reprompt)
 importFrom(fanplot,fan)
 importFrom(nlme,fixef)
 importFrom(nlme,ranef)

R/get_geom_lags.R

@@ -145,7 +145,7 @@ linear_lag <- function (par_lag, min_lag, max_lag){
 #'
 #' This function generates \eqn{Q} lag weights without a parametric constraint. The weights are obtained via
 #' a multinomial logit transformation where the first lag is the reference category.
-#' @param par_lag theparameter vector of length \eqn{Q - 1}
+#' @param par_lag the parameter vector of length \eqn{Q - 1}
 #' @param min_lag smallest lag to include; the support of the Poisson form starts only at \code{min_lag}. Defaults to 1.
 #' @param max_lag highest lag to include; higher lags are cut off and he remaining weights standardized. Defaults to 5.
 #' @export
@@ -157,3 +157,32 @@ unrestricted_lag <- function(par_lag, min_lag, max_lag){
   weights <- c(rep(0, min_lag - 1), weights0)
   return(weights)
 }
+
+#' Discrete Weibull lag function
+#' 
+#' @description The discrete Weibull distribution has probability mass function \insertCite{NakagawaOsaki1975}{Rdpack}
+#' \eqn{p(d; \kappa, \beta) = \kappa ^ {(d - 1) ^ \beta} - \kappa ^ {d ^ \beta}, d = 1, 2, \ldots}
+#' which reduces to the geometric if \eqn{\beta = 1} (\code{geometric_lag}) and the discrete Raleigh distribution if \eqn{\beta = 2} \insertCite{Roy2004}{Rdpack}
+#' 
+#' @param par_lag the parameter vector (must be of length 2)
+#' @param min_lag smallest lag to include
+#' @param max_lag highest lag to include
+#' @references
+#' \insertAllCited
+#' @return the discrete Weibull lag distribution
+#' @importFrom Rdpack reprompt
+#' @importFrom DiscreteWeibull ddweibull
+#' @export
+#' @seealso geometric_lag poisson_lag ar2_lag linear_lag unrestricted_lag
+weibull_lag <- function(par_lag, min_lag, max_lag){
+  if(length(par_lag) != 2){
+    stop("The starting value for par_lag needs to be 2")
+  }
+  p_lag <- exp(par_lag) / (1 + exp(par_lag))
+  weights0 <- c(rep(0, min_lag - 1),
+                DiscreteWeibull::ddweibull((min_lag : max_lag) -
+                                             1, p_lag[1], p_lag[2],
+                                           zero = TRUE))
+  weights <- weights0 / sum(weights0)
+  return(weights)
+}

inst/REFERENCES.bib

@@ -0,0 +1,21 @@
+@article{NakagawaOsaki1975,
+	author = {Nakagawa, T. and Osaki, S.},
+	journal = {IEEE Transactions on Reliability},
+	title = {The Discrete {Weibull} Distribution},
+	year = {1975},
+	volume = {R-24},
+	number = {5},
+	pages = {300--301},
+	doi = {10.1109/TR.1975.5214915}
+}
+
+@article{Roy2004,
+	title = {Discrete {Rayleigh} distribution},
+	author = {Roy, D.},
+	journal = {IEEE Transactions on Reliability},
+	volume = {53},
+	number = {2},
+	pages = {255--260},
+	year = {2004},
+	doi = {10.1109/TR.2004.829161}
+}