diff --git a/NAMESPACE b/NAMESPACE index 5e6ecbbd..88174249 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ S3method(AvailableSugar,forced) S3method(AvailableSugar,static) S3method(BedNetEffectSizes,lemenach) S3method(BedNetEffectSizes,null) +S3method(BedNetEffects,lemenach) S3method(BedNetEffects,null) S3method(Behavior,forced) S3method(Behavior,null) @@ -87,12 +88,12 @@ S3method(HTC,SIS) S3method(HTC,hMoI) S3method(HabitatDynamics,static) S3method(Hydrology,null) -S3method(IRSeffectSizes,null) -S3method(IRSeffects,null) +S3method(IRS_EffectSizes,null) +S3method(IRS_Effects,null) S3method(LBionomics,basic) S3method(LBionomics,trace) -S3method(LSMeffectSizes,null) -S3method(LSMeffects,null) +S3method(LSM_EffectSizes,null) +S3method(LSM_Effects,null) S3method(LocalFrac,dynamic) S3method(LocalFrac,static) S3method(MBionomics,GeRM) @@ -296,11 +297,11 @@ export(F_tau) export(HTC) export(HabitatDynamics) export(Hydrology) -export(IRSeffectSizes) -export(IRSeffects) +export(IRS_EffectSizes) +export(IRS_Effects) export(LBionomics) -export(LSMeffectSizes) -export(LSMeffects) +export(LSM_EffectSizes) +export(LSM_Effects) export(LocalFrac) export(MBionomics) export(MassMedical) diff --git a/R/area_spray.R b/R/area_spray.R index e9b842ac..4839f7b8 100644 --- a/R/area_spray.R +++ b/R/area_spray.R @@ -63,7 +63,6 @@ AreaSprayEffectSizes.null <- function(t, pars) { #' @return [list] #' @export setup_area_spray_null <- function(pars) { - pars = setup_vc_control(pars) AREA_SPRAY <- list() class(AREA_SPRAY) <- 'null' pars$AREA_SPRAY <- AREA_SPRAY diff --git a/R/bednet-interface.R b/R/bednet-interface.R index dac44f16..b822b851 100644 --- a/R/bednet-interface.R +++ b/R/bednet-interface.R @@ -36,9 +36,10 @@ UseBedNet <- function(t, y, pars) { #' @description This method dispatches on the type of `pars$ITNeff`. #' @param t current simulation time #' @param pars a [list] +#' @param s the vector species index #' @return a [list] #' @export -BedNetEffects <- function(t, pars) { +BedNetEffects <- function(t, pars, s) { UseMethod("BedNetEffects", pars$ITNeff) } @@ -46,8 +47,9 @@ BedNetEffects <- function(t, pars) { #' @description This method dispatches on the type of `pars$ITNefsz`. #' @param t current simulation time #' @param pars a [list] +#' @param s the vector species index #' @return a [list] #' @export -BedNetEffectSizes <- function(t, pars) { +BedNetEffectSizes <- function(t, pars, s) { UseMethod("BedNetEffectSizes", pars$ITNefsz) } diff --git a/R/bednet-lemenach.R b/R/bednet-lemenach.R index 2f014ab2..c12ec507 100644 --- a/R/bednet-lemenach.R +++ b/R/bednet-lemenach.R @@ -1,45 +1,44 @@ # specialized methods for the Le Menach model of ITN based vector control -# https://malariajournal.biomedcentral.com/articles/10.1186/1475-2875-6-10 +# https://malariajournal.biomedcentral.com/articles/10.1186/1475-2875-6-10 #' @title Modify baseline values due to vector control #' @description Implements [BedNetEffectSizes] for the Le Menach ITN model of vector control #' @inheritParams BedNetEffectSizes #' @return a named [list] #' @importFrom stats pexp #' @export -BedNetEffectSizes.lemenach <- function(t, pars) { +BedNetEffectSizes.lemenach <- function(t, pars, s){ + with(pars$ITNefsz, with(pars$MYZpar[[s]],{ + n <- length(f) - n <- length(pars$MYZpar$f) + for (i in seq_len(n)) { + tau0 <- (1/f[i]) * tau0_frac - for (i in seq_len(n)) { + p0 <- pexp(q = g[i]*tau0, lower.tail = FALSE) + Q0 <- q[i] + W <- (1-Q0) + Q0*(1-phi) + Q0*phi*ss + Z <- Q0*phi*r - phi <- pars$ITNpar$cover(t) + tau_phi <- tau0 + tau_phi[1] <- tau0[1]/(1-Z) - tau0 <- (1/pars$MYZpar$f[i]) * pars$ITNpar$tau0_frac + f_phi <- 1 / sum(tau_phi) # feeding rate under control - p0 <- pexp(q = pars$MYZpar$g[i] * tau0, lower.tail = FALSE) - Q0 <- pars$MYZpar$q[i] - W <- (1-Q0) + Q0*(1-phi) + Q0*phi*pars$ITNpar$s - Z <- Q0*phi*pars$ITNpar$r + p_phi <- p0 + p_phi[1] <- (p0[1] * W) / (1 - Z*p0[1]) - tau_phi <- tau0 - tau_phi[1] <- tau0[1]/(1-Z) + g_phi <- -f_phi*log(prod(p_phi)) # mortality under control + q_phi <- (Q0*(1-phi) + Q0*phi*ss)/W # human feeding fraction under control - f_phi <- 1 / sum(tau_phi) # feeding rate under control + pars$MYZpar[[s]]$f[i] <- f_phi + pars$MYZpar[[s]]$q[i] <- q_phi + pars$MYZpar[[s]]$g[i] <- g_phi + } - p_phi <- p0 - p_phi[1] <- (p0[1] * W) / (1 - Z*p0[1]) + return(pars) +}))} - g_phi <- -f_phi*log(prod(p_phi)) # mortality under control - q_phi <- (Q0*(1-phi) + Q0*phi*pars$ITNpar$s) / W # human feeding fraction under control - pars$MYZpar$f[i] <- f_phi - pars$MYZpar$q[i] <- q_phi - pars$MYZpar$g[i] <- g_phi - } - - return(pars) -} #' @title Make parameters for Le Menach ITN model of vector control #' @description This model of ITN based vector control was originally described in \url{https://malariajournal.biomedcentral.com/articles/10.1186/1475-2875-6-10}. @@ -48,22 +47,37 @@ BedNetEffectSizes.lemenach <- function(t, pars) { #' in host seeking/bloodfeeding and resting/oviposition #' @param r probability of mosquito being repelled upon contact with ITN #' @param s probability of mosquito successfully feeding upon contact with ITN -#' @param phi a [function] that takes a single argument `t` and returns the level of ITN coverage at that time +#' @param F_phi a [function] that takes as argument `t` and `pars` and returns the level of ITN coverage at that time #' @return none #' @export -setup_itn_lemenach <- function(pars, tau0_frac = c(0.68/3, 2.32/3), r = 0.56, s = 0.03, phi = function(t) {.8} ) { +setup_itn_lemenach <- function(pars, tau0_frac = c(0.68/3, 2.32/3), r = 0.56, s = 0.03, F_phi = function(t, pars){.8} ) { stopifnot(sum(tau0_frac) == 1) - stopifnot(phi(0) >= 0) - stopifnot(phi(0) <= 1) + stopifnot(F_phi(0, pars) >= 0) + stopifnot(F_phi(0, pars) <= 1) - ITNpar <- list() - class(ITNpar) <- 'lemenach' + efsz <- list() + class(efsz) <- 'lemenach' + efsz$tau0_frac <- tau0_frac + efsz$r <- r + efsz$ss <- s + pars$ITNefsz <- efsz - ITNpar$tau0_frac <- tau0_frac - ITNpar$r <- r - ITNpar$s <- s - ITNpar$cover <- phi + coverage = list() + class(coverage) <- "lemenach" + coverage$F_phi = F_phi + pars$ITNeff = coverage - pars$ITNefsz <- ITNpar return(pars) } + +#' @title Modify baseline values due to vector control +#' @description Implements [BedNetEffectSizes] for the Le Menach ITN model of vector control +#' @inheritParams BedNetEffectSizes +#' @return a named [list] +#' @importFrom stats pexp +#' @export +BedNetEffects.lemenach <- function(t, pars, s){ + pars$ITNefsz$phi <- pars$ITNeff$F_phi(t, pars) + return(pars) +} + diff --git a/R/bednet-null.R b/R/bednet-null.R index a1720085..0d552b0d 100644 --- a/R/bednet-null.R +++ b/R/bednet-null.R @@ -32,7 +32,7 @@ UseBedNet.null <- function(t, y, pars) { #' @inheritParams BedNetEffects #' @return a [list] #' @export -BedNetEffects.null <- function(t, pars) { +BedNetEffects.null <- function(t, pars, s) { pars } @@ -41,7 +41,7 @@ BedNetEffects.null <- function(t, pars) { #' @inheritParams BedNetEffectSizes #' @return a [list] #' @export -BedNetEffectSizes.null <- function(t, pars) { +BedNetEffectSizes.null <- function(t, pars,s) { pars } @@ -51,11 +51,11 @@ BedNetEffectSizes.null <- function(t, pars) { #' @export setup_itn_null <- function(pars) { ITN<- list() - class(ITN) <- 'null' - pars$ITNdist<- ITN - pars$ITNown<- ITN - pars$ITNuse<- ITN - pars$ITNeff<- ITN - pars$ITNefsz<- ITN + class(ITN) <- 'null' + pars$ITNdist <- ITN + pars$ITNown <- ITN + pars$ITNuse <- ITN + pars$ITNeff <- ITN + pars$ITNefsz <- ITN return(pars) } diff --git a/R/irs-interface.R b/R/irs-interface.R index 0bff36d2..cd45ebbf 100644 --- a/R/irs-interface.R +++ b/R/irs-interface.R @@ -16,8 +16,8 @@ SprayHouses <- function(t, pars) { #' @param pars a [list] #' @return a [list] #' @export -IRSeffects <- function(t, pars) { - UseMethod("IRS_effects", pars$IRS) +IRS_Effects <- function(t, pars) { + UseMethod("IRS_Effects", pars$IRS) } #' @title Model IRS effect sizes @@ -26,6 +26,6 @@ IRSeffects <- function(t, pars) { #' @param pars a [list] #' @return a [list] #' @export -IRSeffectSizes <- function(t, pars) { - UseMethod("IRSeffectSizes", pars$IRS) +IRS_EffectSizes <- function(t, pars) { + UseMethod("IRS_EffectSizes", pars$IRS) } diff --git a/R/irs-null.R b/R/irs-null.R index 9c0d1448..14606043 100644 --- a/R/irs-null.R +++ b/R/irs-null.R @@ -15,7 +15,7 @@ SprayHouses.null <- function(t, pars) {pars} #' @param pars a [list] #' @return a [list] #' @export -IRSeffects.null <- function(t, pars){pars} +IRS_Effects.null <- function(t, pars){pars} #' @title Model IRS effect sizes #' @description This method dispatches on the type of `pars$IRS`. @@ -23,7 +23,7 @@ IRSeffects.null <- function(t, pars){pars} #' @param pars a [list] #' @return a [list] #' @export -IRSeffectSizes.null <- function(t, pars){pars} +IRS_EffectSizes.null <- function(t, pars){pars} #' @title Make parameters for the null model of IRS (do nothing) #' @param pars a [list] diff --git a/R/lsm-interface.R b/R/lsm-interface.R index dde60f8c..499a2d95 100644 --- a/R/lsm-interface.R +++ b/R/lsm-interface.R @@ -14,21 +14,19 @@ TreatHabitats <- function(t, pars) { #' @title Modify effects of LSM #' @description This method dispatches on the type of `pars$LSM`. #' @param t current simulation time -#' @param y the state of the system #' @param pars a [list] #' @return a [list] #' @export -LSMeffects <- function(t, y, pars) { - UseMethod("LSM_effects", pars$LSM) +LSM_Effects <- function(t, pars) { + UseMethod("LSM_Effects", pars$LSM) } #' @title Compute effect sizes of LSM #' @description This method dispatches on the type of `pars$LSM`. #' @param t current simulation time -#' @param y the state of the system #' @param pars a [list] #' @return a [list] #' @export -LSMeffectSizes <- function(t, y, pars) { - UseMethod("LSM_effect_size", pars$LSM) +LSM_EffectSizes <- function(t, pars) { + UseMethod("LSM_EffectSizes", pars$LSM) } diff --git a/R/lsm-null.R b/R/lsm-null.R index 15d527f4..80d7d9c5 100644 --- a/R/lsm-null.R +++ b/R/lsm-null.R @@ -11,19 +11,19 @@ TreatHabitats.null <- function(t, pars) { #' @title Modify effects of LSM, the null model #' @description This method dispatches on the type of `pars$LSM` -#' @inheritParams LSMeffects +#' @inheritParams LSM_Effects #' @return a [list] #' @export -LSMeffects.null <- function(t, y, pars) { +LSM_Effects.null <- function(t, pars) { pars } #' @title Modify effects of LSM, the null model #' @description This method dispatches on the type of `pars$LSM` -#' @inheritParams LSMeffectSizes +#' @inheritParams LSM_EffectSizes #' @return a [list] #' @export -LSMeffectSizes.null <- function(t, y, pars) { +LSM_EffectSizes.null <- function(t, pars) { pars } @@ -33,6 +33,7 @@ LSMeffectSizes.null <- function(t, y, pars) { #' @export setup_lsm_null <- function(pars) { LSM <- list() - class(LSM) <- 'null' + class(LSM) <- "null" + pars$LSM <- LSM return(pars) } diff --git a/R/sugar_baits-interface.R b/R/sugar_baits-interface.R index b82d5fcc..aaec899a 100644 --- a/R/sugar_baits-interface.R +++ b/R/sugar_baits-interface.R @@ -13,22 +13,20 @@ SugarBaits <- function(t, pars) { #' @title Methods for the durability and effects of the sugar baits #' @description This method dispatches on the type of `pars$SUGAR_BAITS`. #' @param t current simulation time -#' @param y vector of state variables #' @param pars a [list] #' @return [list] #' @export -SugarBaitEffects <- function(t, y, pars) { +SugarBaitEffects <- function(t, pars) { UseMethod("SugarBaitEffects", pars$SUGAR_BAITS) } #' @title Methods for the effect sizes of the sugar baits #' @description This method dispatches on the type of `pars$SUGAR_BAITS`. #' @param t current simulation time -#' @param y vector of state variables #' @param pars a [list] #' @return [list] #' @export -SugarBaitEffectSizes <- function(t, y, pars) { +SugarBaitEffectSizes <- function(t, pars) { UseMethod("SugarBaitEffectSizes", pars$SUGAR_BAITS) } diff --git a/R/sugar_baits-null.R b/R/sugar_baits-null.R index f372460a..708e2b50 100644 --- a/R/sugar_baits-null.R +++ b/R/sugar_baits-null.R @@ -13,7 +13,7 @@ SugarBaits.null <- function(t, pars) { #' @inheritParams SugarBaitEffects #' @return [list] #' @export -SugarBaitEffects.null <- function(t, y, pars) { +SugarBaitEffects.null <- function(t, pars) { return(pars) } @@ -22,6 +22,6 @@ SugarBaitEffects.null <- function(t, y, pars) { #' @inheritParams SugarBaitEffectSizes #' @return [list] #' @export -SugarBaitEffectSizes.null <- function(t, y, pars) { +SugarBaitEffectSizes.null <- function(t, pars) { return(pars) } diff --git a/R/vector_control-control.R b/R/vector_control-control.R index e6d4f460..f547b344 100644 --- a/R/vector_control-control.R +++ b/R/vector_control-control.R @@ -9,8 +9,8 @@ VectorControl.control <- function(t, y, pars) { pars = DistributeBedNets(t, pars) pars = OwnBedNet(t, y, pars) - pars = AreaSpray(t, pars) pars = SprayHouses(t, pars) + pars = AreaSpray(t, pars) pars = SugarBaits(t, pars) pars = TreatHabitats(t, pars) return(pars) @@ -22,11 +22,13 @@ VectorControl.control <- function(t, y, pars) { #' @return a named [list] #' @export VectorControlEffects.control <- function(t, y, pars) { - pars = BedNetEffects(t, pars) + for(s in 1:pars$nVectors){ + pars = BedNetEffects(t, pars,s) + } pars = AreaSprayEffects(t, pars) - pars = IRSeffects(t, pars) + pars = IRS_Effects(t, pars) pars = SugarBaitEffects(t, pars) - pars = LSMeffects(t, pars) + pars = LSM_Effects(t, pars) return(pars) } @@ -36,11 +38,13 @@ VectorControlEffects.control <- function(t, y, pars) { #' @return a named [list] #' @export VectorControlEffectSizes.control <- function(t, y, pars) { - pars = BedNetEffectSizes(t, pars) pars = AreaSprayEffectSizes(t, pars) - pars = IRSeffectSizes(t, pars) + pars = IRS_EffectSizes(t, pars) pars = SugarBaitEffectSizes(t, pars) - pars = LSMeffectSizes(t, pars) + pars = LSM_EffectSizes(t, pars) + for(s in 1:pars$nVectors){ + pars = BedNetEffectSizes(t, pars, s) + } return(pars) } @@ -49,7 +53,6 @@ VectorControlEffectSizes.control <- function(t, y, pars) { #' @return none #' @export setup_vc_control <- function(pars) { - pars = setup_control(pars) class(pars$VECTOR_CONTROL) <- 'control' pars <- setup_itn_null(pars) pars <- setup_area_spray_null(pars) diff --git a/R/vector_control-interface.R b/R/vector_control-interface.R index 96b2f577..be94d1c6 100644 --- a/R/vector_control-interface.R +++ b/R/vector_control-interface.R @@ -19,7 +19,7 @@ VectorControl <- function(t, y, pars) { #' @return a [list] #' @export VectorControlEffects <- function(t, y, pars) { - UseMethod("VectorControlEffectSizes", pars$VECTOR_CONTROL) + UseMethod("VectorControlEffects", pars$VECTOR_CONTROL) } #' @title Vector control effect sizes diff --git a/_pkgdown.yml b/_pkgdown.yml index 8c55e109..4ec54617 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -698,6 +698,7 @@ reference: - BedNetEffects.null - BedNetEffectSizes.null - setup_itn_null + - BedNetEffects.lemenach - BedNetEffectSizes.lemenach - setup_itn_lemenach - subtitle: Indoor Residual Spraying @@ -705,11 +706,11 @@ reference: Methods to implement IRS contents: - SprayHouses - - IRSeffects - - IRSeffectSizes + - IRS_Effects + - IRS_EffectSizes - SprayHouses.null - - IRSeffects.null - - IRSeffectSizes.null + - IRS_Effects.null + - IRS_EffectSizes.null - setup_irs_null - subtitle: Area Spraying desc: | @@ -738,11 +739,11 @@ reference: Methods to implement LSM contents: - TreatHabitats - - LSMeffects - - LSMeffectSizes + - LSM_Effects + - LSM_EffectSizes - TreatHabitats.null - - LSMeffects.null - - LSMeffectSizes.null + - LSM_Effects.null + - LSM_EffectSizes.null - setup_lsm_null - subtitle: Ovitraps desc: | diff --git a/man/BedNetEffectSizes.Rd b/man/BedNetEffectSizes.Rd index e960a08b..730b03cf 100644 --- a/man/BedNetEffectSizes.Rd +++ b/man/BedNetEffectSizes.Rd @@ -4,12 +4,14 @@ \alias{BedNetEffectSizes} \title{Modify baseline bionomic parameters, called from VectorControlEffectSizes} \usage{ -BedNetEffectSizes(t, pars) +BedNetEffectSizes(t, pars, s) } \arguments{ \item{t}{current simulation time} \item{pars}{a \link{list}} + +\item{s}{the vector species index} } \value{ a \link{list} diff --git a/man/BedNetEffectSizes.lemenach.Rd b/man/BedNetEffectSizes.lemenach.Rd index 9eae3879..b37a0be6 100644 --- a/man/BedNetEffectSizes.lemenach.Rd +++ b/man/BedNetEffectSizes.lemenach.Rd @@ -4,12 +4,14 @@ \alias{BedNetEffectSizes.lemenach} \title{Modify baseline values due to vector control} \usage{ -\method{BedNetEffectSizes}{lemenach}(t, pars) +\method{BedNetEffectSizes}{lemenach}(t, pars, s) } \arguments{ \item{t}{current simulation time} \item{pars}{a \link{list}} + +\item{s}{the vector species index} } \value{ a named \link{list} diff --git a/man/BedNetEffectSizes.null.Rd b/man/BedNetEffectSizes.null.Rd index 6bfac9c8..619daa0f 100644 --- a/man/BedNetEffectSizes.null.Rd +++ b/man/BedNetEffectSizes.null.Rd @@ -4,12 +4,14 @@ \alias{BedNetEffectSizes.null} \title{Bed net ownership} \usage{ -\method{BedNetEffectSizes}{null}(t, pars) +\method{BedNetEffectSizes}{null}(t, pars, s) } \arguments{ \item{t}{current simulation time} \item{pars}{a \link{list}} + +\item{s}{the vector species index} } \value{ a \link{list} diff --git a/man/BedNetEffects.Rd b/man/BedNetEffects.Rd index 1d5c74c6..50fc8e41 100644 --- a/man/BedNetEffects.Rd +++ b/man/BedNetEffects.Rd @@ -4,12 +4,14 @@ \alias{BedNetEffects} \title{Modify variables or parameters, called from VectorControlEffects} \usage{ -BedNetEffects(t, pars) +BedNetEffects(t, pars, s) } \arguments{ \item{t}{current simulation time} \item{pars}{a \link{list}} + +\item{s}{the vector species index} } \value{ a \link{list} diff --git a/man/BedNetEffects.lemenach.Rd b/man/BedNetEffects.lemenach.Rd new file mode 100644 index 00000000..7c5f6f4a --- /dev/null +++ b/man/BedNetEffects.lemenach.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bednet-lemenach.R +\name{BedNetEffects.lemenach} +\alias{BedNetEffects.lemenach} +\title{Modify baseline values due to vector control} +\usage{ +\method{BedNetEffects}{lemenach}(t, pars, s) +} +\arguments{ +\item{t}{current simulation time} + +\item{pars}{a \link{list}} + +\item{s}{the vector species index} +} +\value{ +a named \link{list} +} +\description{ +Implements \link{BedNetEffectSizes} for the Le Menach ITN model of vector control +} diff --git a/man/BedNetEffects.null.Rd b/man/BedNetEffects.null.Rd index c76316bb..a789b3c6 100644 --- a/man/BedNetEffects.null.Rd +++ b/man/BedNetEffects.null.Rd @@ -4,12 +4,14 @@ \alias{BedNetEffects.null} \title{Bed net ownership} \usage{ -\method{BedNetEffects}{null}(t, pars) +\method{BedNetEffects}{null}(t, pars, s) } \arguments{ \item{t}{current simulation time} \item{pars}{a \link{list}} + +\item{s}{the vector species index} } \value{ a \link{list} diff --git a/man/IRSeffectSizes.Rd b/man/IRS_EffectSizes.Rd similarity index 80% rename from man/IRSeffectSizes.Rd rename to man/IRS_EffectSizes.Rd index f3b70151..b305e2a6 100644 --- a/man/IRSeffectSizes.Rd +++ b/man/IRS_EffectSizes.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/irs-interface.R -\name{IRSeffectSizes} -\alias{IRSeffectSizes} +\name{IRS_EffectSizes} +\alias{IRS_EffectSizes} \title{Model IRS effect sizes} \usage{ -IRSeffectSizes(t, pars) +IRS_EffectSizes(t, pars) } \arguments{ \item{t}{current simulation time} diff --git a/man/IRSeffectSizes.null.Rd b/man/IRS_EffectSizes.null.Rd similarity index 75% rename from man/IRSeffectSizes.null.Rd rename to man/IRS_EffectSizes.null.Rd index 7a1e1564..7eb42b5a 100644 --- a/man/IRSeffectSizes.null.Rd +++ b/man/IRS_EffectSizes.null.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/irs-null.R -\name{IRSeffectSizes.null} -\alias{IRSeffectSizes.null} +\name{IRS_EffectSizes.null} +\alias{IRS_EffectSizes.null} \title{Model IRS effect sizes} \usage{ -\method{IRSeffectSizes}{null}(t, pars) +\method{IRS_EffectSizes}{null}(t, pars) } \arguments{ \item{t}{current simulation time} diff --git a/man/IRSeffects.Rd b/man/IRS_Effects.Rd similarity index 83% rename from man/IRSeffects.Rd rename to man/IRS_Effects.Rd index 6355eb9b..f94dadb1 100644 --- a/man/IRSeffects.Rd +++ b/man/IRS_Effects.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/irs-interface.R -\name{IRSeffects} -\alias{IRSeffects} +\name{IRS_Effects} +\alias{IRS_Effects} \title{Model the effects of IRS} \usage{ -IRSeffects(t, pars) +IRS_Effects(t, pars) } \arguments{ \item{t}{current simulation time} diff --git a/man/IRSeffects.null.Rd b/man/IRS_Effects.null.Rd similarity index 78% rename from man/IRSeffects.null.Rd rename to man/IRS_Effects.null.Rd index a6d67eac..6675ba59 100644 --- a/man/IRSeffects.null.Rd +++ b/man/IRS_Effects.null.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/irs-null.R -\name{IRSeffects.null} -\alias{IRSeffects.null} +\name{IRS_Effects.null} +\alias{IRS_Effects.null} \title{Model the effects of IRS} \usage{ -\method{IRSeffects}{null}(t, pars) +\method{IRS_Effects}{null}(t, pars) } \arguments{ \item{t}{current simulation time} diff --git a/man/LSMeffectSizes.Rd b/man/LSM_EffectSizes.Rd similarity index 74% rename from man/LSMeffectSizes.Rd rename to man/LSM_EffectSizes.Rd index 3c28bf73..a7c51847 100644 --- a/man/LSMeffectSizes.Rd +++ b/man/LSM_EffectSizes.Rd @@ -1,16 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/lsm-interface.R -\name{LSMeffectSizes} -\alias{LSMeffectSizes} +\name{LSM_EffectSizes} +\alias{LSM_EffectSizes} \title{Compute effect sizes of LSM} \usage{ -LSMeffectSizes(t, y, pars) +LSM_EffectSizes(t, pars) } \arguments{ \item{t}{current simulation time} -\item{y}{the state of the system} - \item{pars}{a \link{list}} } \value{ diff --git a/man/LSMeffects.null.Rd b/man/LSM_EffectSizes.null.Rd similarity index 72% rename from man/LSMeffects.null.Rd rename to man/LSM_EffectSizes.null.Rd index 60f3e2d3..f3bac751 100644 --- a/man/LSMeffects.null.Rd +++ b/man/LSM_EffectSizes.null.Rd @@ -1,16 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/lsm-null.R -\name{LSMeffects.null} -\alias{LSMeffects.null} +\name{LSM_EffectSizes.null} +\alias{LSM_EffectSizes.null} \title{Modify effects of LSM, the null model} \usage{ -\method{LSMeffects}{null}(t, y, pars) +\method{LSM_EffectSizes}{null}(t, pars) } \arguments{ \item{t}{current simulation time} -\item{y}{the state of the system} - \item{pars}{a \link{list}} } \value{ diff --git a/man/LSMeffects.Rd b/man/LSM_Effects.Rd similarity index 76% rename from man/LSMeffects.Rd rename to man/LSM_Effects.Rd index 0e5a8731..c5e46ae4 100644 --- a/man/LSMeffects.Rd +++ b/man/LSM_Effects.Rd @@ -1,16 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/lsm-interface.R -\name{LSMeffects} -\alias{LSMeffects} +\name{LSM_Effects} +\alias{LSM_Effects} \title{Modify effects of LSM} \usage{ -LSMeffects(t, y, pars) +LSM_Effects(t, pars) } \arguments{ \item{t}{current simulation time} -\item{y}{the state of the system} - \item{pars}{a \link{list}} } \value{ diff --git a/man/LSMeffectSizes.null.Rd b/man/LSM_Effects.null.Rd similarity index 70% rename from man/LSMeffectSizes.null.Rd rename to man/LSM_Effects.null.Rd index 7c740bef..9999ac8b 100644 --- a/man/LSMeffectSizes.null.Rd +++ b/man/LSM_Effects.null.Rd @@ -1,16 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/lsm-null.R -\name{LSMeffectSizes.null} -\alias{LSMeffectSizes.null} +\name{LSM_Effects.null} +\alias{LSM_Effects.null} \title{Modify effects of LSM, the null model} \usage{ -\method{LSMeffectSizes}{null}(t, y, pars) +\method{LSM_Effects}{null}(t, pars) } \arguments{ \item{t}{current simulation time} -\item{y}{the state of the system} - \item{pars}{a \link{list}} } \value{ diff --git a/man/SugarBaitEffectSizes.Rd b/man/SugarBaitEffectSizes.Rd index 3d04e24b..66b94036 100644 --- a/man/SugarBaitEffectSizes.Rd +++ b/man/SugarBaitEffectSizes.Rd @@ -4,13 +4,11 @@ \alias{SugarBaitEffectSizes} \title{Methods for the effect sizes of the sugar baits} \usage{ -SugarBaitEffectSizes(t, y, pars) +SugarBaitEffectSizes(t, pars) } \arguments{ \item{t}{current simulation time} -\item{y}{vector of state variables} - \item{pars}{a \link{list}} } \value{ diff --git a/man/SugarBaitEffectSizes.null.Rd b/man/SugarBaitEffectSizes.null.Rd index 0e04b4ac..6b31a155 100644 --- a/man/SugarBaitEffectSizes.null.Rd +++ b/man/SugarBaitEffectSizes.null.Rd @@ -4,13 +4,11 @@ \alias{SugarBaitEffectSizes.null} \title{Methods for the effect sizes of the sugar baits} \usage{ -\method{SugarBaitEffectSizes}{null}(t, y, pars) +\method{SugarBaitEffectSizes}{null}(t, pars) } \arguments{ \item{t}{current simulation time} -\item{y}{vector of state variables} - \item{pars}{a \link{list}} } \value{ diff --git a/man/SugarBaitEffects.Rd b/man/SugarBaitEffects.Rd index 57fae517..08903900 100644 --- a/man/SugarBaitEffects.Rd +++ b/man/SugarBaitEffects.Rd @@ -4,13 +4,11 @@ \alias{SugarBaitEffects} \title{Methods for the durability and effects of the sugar baits} \usage{ -SugarBaitEffects(t, y, pars) +SugarBaitEffects(t, pars) } \arguments{ \item{t}{current simulation time} -\item{y}{vector of state variables} - \item{pars}{a \link{list}} } \value{ diff --git a/man/SugarBaitEffects.null.Rd b/man/SugarBaitEffects.null.Rd index cc64a014..3126029c 100644 --- a/man/SugarBaitEffects.null.Rd +++ b/man/SugarBaitEffects.null.Rd @@ -4,13 +4,11 @@ \alias{SugarBaitEffects.null} \title{Methods for the effects of the sugar baits} \usage{ -\method{SugarBaitEffects}{null}(t, y, pars) +\method{SugarBaitEffects}{null}(t, pars) } \arguments{ \item{t}{current simulation time} -\item{y}{vector of state variables} - \item{pars}{a \link{list}} } \value{ diff --git a/man/setup_itn_lemenach.Rd b/man/setup_itn_lemenach.Rd index 73c5ad86..e6448b53 100644 --- a/man/setup_itn_lemenach.Rd +++ b/man/setup_itn_lemenach.Rd @@ -9,7 +9,7 @@ setup_itn_lemenach( tau0_frac = c(0.68/3, 2.32/3), r = 0.56, s = 0.03, - phi = function(t) { + F_phi = function(t, pars) { 0.8 } ) @@ -24,7 +24,7 @@ in host seeking/bloodfeeding and resting/oviposition} \item{s}{probability of mosquito successfully feeding upon contact with ITN} -\item{phi}{a \link{function} that takes a single argument \code{t} and returns the level of ITN coverage at that time} +\item{F_phi}{a \link{function} that takes as argument \code{t} and \code{pars} and returns the level of ITN coverage at that time} } \value{ none diff --git a/tests/testthat/test-vc-lemenach.R b/tests/testthat/test-vc-lemenach.R index 449187e1..2a4e9a89 100644 --- a/tests/testthat/test-vc-lemenach.R +++ b/tests/testthat/test-vc-lemenach.R @@ -83,9 +83,11 @@ test_that("Le Menach VC model with 0 coverage stays roughly at equilibrium", { pars = make_inits_MYZ_RM_dde(pars = pars, M0 = as.vector(M), P0 = as.vector(P), Y0 = as.vector(Y), Z0 = as.vector(Z), Upsilon0=Upsilon) pars = make_parameters_L_trace(pars = pars, Lambda = as.vector(Lambda)) pars = make_inits_L_trace(pars = pars) - pars = setup_itn_lemenach(pars = pars, phi=function(t){0}) pars = make_parameters_X_SIS(pars = pars, b = b, c = c, r = r) pars = make_inits_X_SIS(pars = pars, H-I, I) + pars = setup_control_forced(pars) + pars = setup_vc_control(pars) + pars = setup_itn_lemenach(pars = pars, F_phi=function(t, pars){0}) pars$calU[[1]] <- diag(pars$nPatches) pars$calN <- diag(pars$nHabitats) diff --git a/vignettes/environmental_heterogeneity.Rmd b/vignettes/environmental_heterogeneity.Rmd index ae978c8e..0e11a676 100644 --- a/vignettes/environmental_heterogeneity.Rmd +++ b/vignettes/environmental_heterogeneity.Rmd @@ -14,10 +14,67 @@ knitr::opts_chunk$set( ) ``` -Heterogeneous blood feeding is a basic feature of malaria transmission (see [Heterogeneous Transmission](heterogeneous_transmission.html)). In `exDE` the term **environmental heterogeneity** is used to describe the distribution of the expected number of bites within a homogenous human population stratum: biting is extremely heterogeneous even for individuals who have the same expectation. The approach is motivated by a study of heterogeneous exposure by (Cooper L, *et al.*, 2019)^[Cooper L, Kang SY, *et al.* (2019). Pareto rules for malaria super-spreaders and super-spreading. Nat Commun 10, 3939, https://doi.org/10.1038/s41467-019-11861-y]. +Heterogeneous blood feeding is a basic feature of malaria transmission (see [Heterogeneous Transmission](heterogeneous_transmission.html)). In `exDE` the term **environmental heterogeneity** is used to describe the distribution of the expected number of bites within a homogenous human population stratum: biting is extremely heterogeneous even for individuals who have the same expectation. The approach is motivated by a study of heterogeneous exposure by (Cooper L, *et al.*, 2019)^[Cooper L, Kang SY, *et al.* (2019). Pareto rules for malaria super-spreaders and super-spreading. Nat Commun 10, 3939, https://doi.org/10.1038/s41467-019-11861-y]. -## The Force of Infection and Attack Rates +In the following, we derive formulas for the force of infection (FoI) from the model for the attack rate (AR) under the Poisson and . +## Attack Rates and the Force of Infection + +In mechanistic models of malaria, the hazard rate for exposure is generally assumed to be a linear function of the entomological inoculation rate. In the following, we assume that the number of bites per person over a day (or over some longer interval, $\tau$), is a random variable, and we formulate approximating models for attack rates and hazard rates. + +### Poisson Hazard Rates + +We let $E$ denote the EIR, the expected number of bites per person over a day. If we assume that the distribution of the daily EIR is Poisson, and if a fraction $b$ of infective bites cause an infection, then the relationship between the between EIR and the FoI is a Poisson compounded with a binomial, which is also Poisson: + +$$ +Z \sim F_E(z) = \mbox{Poisson}(z, \mbox{mu} = bE(t)) +$$ + +Over a day, the daily attack rate, $\alpha$, is the fraction of individuals who received at least one infection, or: + +$$ +\begin{array}{rl} +\alpha &= 1-F_E(0) \\ &= 1-\mbox{Poisson}(0, \mbox{mu} = bE(t)) \\ +&= 1- e^{-bE(t)} \\ +\end{array} +$$ + +The daily FoI, $h$, is given by a generic formula: + +$$ +\alpha = 1 - e^{-h} \mbox{ or equivalently } h = -\ln (1-\alpha) +$$ + +In this case, the relationship between the FoI and the EIR is: + +$$ + h(t) = b E(t) +$$ + +It is highly mathematically convenient that the relationship is invariant with respect to the sampling period. + +### Negative Binomial Daily Hazards + +If we assume the number of infective bites, per person, per day, has a Gamma distribution in a population, then we could model the number of infective bites as a Gamma - Poisson mixture process, or a negative binomial distribution. Under this model, the counts for bites by sporozoite positive mosquitoes over one day, $Z$, would be a negative binomial random variable with mean $E$: + +$$ +Z \sim F_E(z) = \mbox{NB}(z, \mbox{mu} = bE(t), \mbox{size} = 1/\phi) +$$ + +Assuming an infectious bite causes an infection with probability $b$, the daily attack rate is: + +$$ +\begin{array}{rl} +\alpha &= 1-F_E(0) \\ &= 1-\mbox{NB}(0, \mbox{mu} = b E(t), \mbox{size} = 1/\phi) \\ + &= 1- \left(1+b E(t)\phi \right)^{-1/\phi} +\end{array} +$$ + +This is consistent with a formula that has a continuous daily FoI: + +$$ + h = \frac{\ln \left(1 + bE(t)\phi \right)} {\phi} +$$ diff --git a/vignettes/heterogeneous_biting.Rmd b/vignettes/heterogeneous_biting.Rmd index 8b12b344..39b226a5 100644 --- a/vignettes/heterogeneous_biting.Rmd +++ b/vignettes/heterogeneous_biting.Rmd @@ -79,6 +79,7 @@ W = sum(searchWts*Hi) xi = searchWts*H/W xi ``` + ```{r} sum(xi*Hi)/H ``` diff --git a/vignettes/vc_lemenach.Rmd b/vignettes/vc_lemenach.Rmd index 0ca6c237..b11dc65e 100644 --- a/vignettes/vc_lemenach.Rmd +++ b/vignettes/vc_lemenach.Rmd @@ -157,20 +157,25 @@ xde_setup(MYZname="RM", Xname="SIS", Lname="basic", ``` ```{r} -itn_mod <- setup_control(itn_mod) +itn_mod <- setup_control_forced(itn_mod) ``` +```{r} +itn_mod <- setup_vc_control(itn_mod) +``` + + If we ran the model at this point, we would get the baseline. Instead, we set up a time-varying function to compute the coverage of ITNs at any time point. We use a sine curve with a period of 365 days which goes from 0 to 1 over that period, with the phase shifted so that at 0 it returns 0. The function also returns 0 for any $t<0$. This must be a function that takes a single argument `t` (time) and returns a scalar value. ```{r} # ITN coverage -ITN_cov <- function(t) {ifelse(t < 0, 0, (sin(2*pi*(t-365/4) / 365) + 1) / 2)} +ITN_cov <- function(t, pars){ifelse(t < 0, 0, (sin(2*pi*(t-365/4) / 365) + 1) / 2)} ``` We use the null model of human demographic dynamics, which assumes $H$ is constant for all time. ```{r} -itn_mod = setup_itn_lemenach(itn_mod, phi = ITN_cov) +itn_mod = setup_itn_lemenach(itn_mod, F_phi=ITN_cov) ``` ```{r}