Skip to content

Commit

Permalink
Moving towards a final version of ramp.xds
Browse files Browse the repository at this point in the history
+ Fixed some issues in plot-terms.R
+ Changed notation from season(t) to F_season(t); from trend(t) to F_trend(t)
+ Changes to the documentation
  • Loading branch information
smitdave committed Sep 4, 2024
1 parent 1e8ca00 commit 2a42e8c
Show file tree
Hide file tree
Showing 762 changed files with 3,191 additions and 9,303 deletions.
1 change: 0 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -663,7 +663,6 @@ export(xds_lines_Y)
export(xds_lines_Y_fracs)
export(xds_lines_Z)
export(xds_lines_Z_fracs)
export(xds_lines_aEIR)
export(xds_plot_EIR)
export(xds_plot_M)
export(xds_plot_PR)
Expand Down
19 changes: 10 additions & 9 deletions R/adult-basicM.R
Original file line number Diff line number Diff line change
Expand Up @@ -66,15 +66,16 @@ Update_MYZt.basicM <- function(t, y, pars, s) {
#' @export
make_MYZpar.basicM = function(MYZname, pars, s, MYZopts=list()){
setup_as = with(MYZopts, ifelse(exists("setup_as"), setup_as, "RM"))
if(setup_as == "GeRM"){
MYZpar <- create_MYZpar_GeRM(pars$nPatches, MYZopts)
} else {
MYZpar <- create_MYZpar_RM(pars$nPatches, MYZopts)
}
class(MYZpar) <- 'basicM'
pars$MYZpar[[s]] = MYZpar
return(pars)
}
with(MYZopts,{
if(setup_as == "GeRM"){
MYZpar <- create_MYZpar_GeRM(pars$nPatches, MYZopts)
} else {
MYZpar <- create_MYZpar_RM(pars$nPatches, MYZopts)
}
class(MYZpar) <- 'basicM'
pars$MYZpar[[s]] = MYZpar
return(pars)
})}



Expand Down
41 changes: 21 additions & 20 deletions R/adult-interface.R
Original file line number Diff line number Diff line change
Expand Up @@ -13,26 +13,6 @@ dMYZdt <- function(t, y, pars, s) {
UseMethod("dMYZdt", pars$MYZpar[[s]])
}

#' @title Compute steady states for \eqn{\cal MYZ} models
#' @description This method dispatches on the type of `MYZpar`.
#' @param Lambda the daily emergence rate of adult mosquitoes
#' @param kappa net infectiousness
#' @param MYZpar a list that defines an adult model
#' @return none
#' @export
xde_steady_state_MYZ = function(Lambda, kappa, MYZpar){
UseMethod("xde_steady_state_MYZ", MYZpar)
}

#' @title Compute the steady states as a function of the daily EIR
#' @description This method dispatches on the type of `MYZpar`.
#' @param Lambda the daily emergence rate of adult mosquitoes
#' @param MYZpar a list that defines an adult model
#' @return none
#' @export
xde_steady_state_M = function(Lambda, MYZpar){
UseMethod("xde_steady_state_M", MYZpar)
}

#' @title A function to set up adult mosquito models
#' @description This method dispatches on `MYZname`.
Expand Down Expand Up @@ -230,3 +210,24 @@ get_g = function(pars, s=1){
get_sigma = function(pars, s=1){
UseMethod("get_sigma", pars$MYZpar[[s]]$baseline)
}

#' @title Compute steady states for \eqn{\cal MYZ} models
#' @description This method dispatches on the type of `MYZpar`.
#' @param Lambda the daily emergence rate of adult mosquitoes
#' @param kappa net infectiousness
#' @param MYZpar a list that defines an adult model
#' @return none
#' @export
xde_steady_state_MYZ = function(Lambda, kappa, MYZpar){
UseMethod("xde_steady_state_MYZ", MYZpar)
}

#' @title Compute the steady states as a function of the daily EIR
#' @description This method dispatches on the type of `MYZpar`.
#' @param Lambda the daily emergence rate of adult mosquitoes
#' @param MYZpar a list that defines an adult model
#' @return none
#' @export
xde_steady_state_M = function(Lambda, MYZpar){
UseMethod("xde_steady_state_M", MYZpar)
}
6 changes: 4 additions & 2 deletions R/adult-si.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,12 @@
#' \deqn{
#' \begin{array}{rr}
#' dM/dt =& \Lambda &- \Omega \cdot M \\
#' dY/dt =& f q \kappa (M-Y) &- \Omega \cdot Y
#' dY/dt =& f q \kappa (M-Y) &- \Omega \cdot Y \\
#' \end{array}.
#' }
#' The model assumes \eqn{Z = \Upsilon Y}
#' and infectious mosquitoes are by the variable
#' \deqn{Z = e^{-\Omega \tau} \cdot Y}
#'
#' @inheritParams dMYZdt
#' @return a [numeric] vector
#' @export
Expand Down
14 changes: 7 additions & 7 deletions R/adult-trivial.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
F_fqZ.trivial <- function(t, y, pars, s) {
f = get_f(pars, s)
q = get_q(pars, s)
Z = with(pars$MYZpar[[s]], Z*season(t)*trend(t))
Z = with(pars$MYZpar[[s]], Z*F_season(t)*F_trend(t))
return(f*q*Z)
}

Expand All @@ -19,7 +19,7 @@ F_fqZ.trivial <- function(t, y, pars, s) {
#' @export
F_eggs.trivial <- function(t, y, pars, s) {
with(pars$MYZpar[[s]],
return(eggs*season(t)*trend(t))
return(eggs*F_season(t)*F_trend(t))
)}

#' @title Blood feeding rate of the infective mosquito population
Expand Down Expand Up @@ -79,13 +79,13 @@ xde_steady_state_MYZ.trivial = function(Lambda, kappa, MYZpar){with(MYZpar,{
#' @param q the human fraction
#' @param Z the human fraction
#' @param eggs the human fraction
#' @param season a seasonality function
#' @param trend a trend function
#' @param F_season a F_seasonality function
#' @param F_trend a F_trend function
#' @return none
#' @export
create_MYZpar_trivial = function(nPatches, MYZopts,
f = 1, q = 1, Z=1, eggs=1,
season = F_flat, trend=F_flat){
F_season = F_flat, F_trend=F_flat){
with(MYZopts,{
MYZpar <- list()
MYZpar$nPatches <- nPatches
Expand All @@ -106,8 +106,8 @@ create_MYZpar_trivial = function(nPatches, MYZopts,

MYZpar$Z <- checkIt(Z, nPatches)
MYZpar$eggs <- checkIt(eggs, nPatches)
MYZpar$season <- season
MYZpar$trend <- trend
MYZpar$F_season <- F_season
MYZpar$F_trend <- F_trend
return(MYZpar)
})}

Expand Down
2 changes: 1 addition & 1 deletion R/aquatic-basicL.R
Original file line number Diff line number Diff line change
Expand Up @@ -166,7 +166,7 @@ create_Linits_basicL = function(nHabitats, Lopts=list(), L=1){with(Lopts,{
#' @title Parse the variable names for the basicL model
#' @description Implements [parse_Lorbits] for basicL competition model.
#' @inheritParams parse_Lorbits
#' @return [list]
#' @return a parsed [list]; the variables are attached by name
#' @export
parse_Lorbits.basicL <- function(outputs, pars, s) {
L = outputs[,pars$ix$L[[s]]$L_ix]
Expand Down
17 changes: 9 additions & 8 deletions R/aquatic-trivial.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,26 +5,27 @@
#' @inheritParams F_emerge
#' @return a [numeric] vector of length `nHabitats`
#' @export
F_emerge.trivial <- function(t, y, pars, s) {
with(pars$Lpar[[s]], Lambda*season(t)*trend(t))
}
F_emerge.trivial <- function(t, y, pars, s) {with(pars$Lpar[[s]],{
emergents = Lambda*F_season(t)*F_trend(t)
return(emergents)
})}

#' @title Make parameters for trivial aquatic mosquito model
#' @param nHabitats the number of habitats in the model
#' @param Lopts a [list] that overwrites default values
#' @param Lambda vector of mean emergence rates from each aquatic habitat
#' @param season a function that gives a seasonal pattern
#' @param trend a function that returns a temporal trend
#' @param F_season a function that gives a F_seasonal pattern
#' @param F_trend a function that returns a temporal F_trend
#' @return none
#' @export
create_Lpar_trivial = function(nHabitats, Lopts=list(),
Lambda=1000, season=F_flat, trend=F_flat){
Lambda=1000, F_season=F_flat, F_trend=F_flat){
with(Lopts,{
Lpar = list()
class(Lpar) <- "trivial"
Lpar$Lambda = checkIt(Lambda, nHabitats)
Lpar$season = season
Lpar$trend = trend
Lpar$F_season = F_season
Lpar$F_trend = F_trend
Lpar$baseline = "trivial"
class(Lpar$baseline) = "trivial"
return(Lpar)
Expand Down
12 changes: 6 additions & 6 deletions R/human-trivial.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
#' @export
F_X.trivial <- function(t, y, pars, i) {
H = F_H(t, y, pars, i)
X = with(pars$Xpar[[i]], H*kappa*season(t)*trend(t))
X = with(pars$Xpar[[i]], H*kappa*F_season(t)*F_trend(t))
return(X)
}

Expand All @@ -25,18 +25,18 @@ F_H.trivial <- function(t, y, pars, i) {
#' @param Xopts a [list]
#' @param kappa net infectiousness
#' @param HPop initial human population density
#' @param season a seasonality function
#' @param trend a trend function
#' @param F_season a F_seasonality function
#' @param F_trend a F_trend function
#' @return a [list]
#' @export
create_Xpar_trivial <- function(nPatches, Xopts, kappa=.1, HPop=1,
season=F_flat, trend=F_flat){with(Xopts,{
F_season=F_flat, F_trend=F_flat){with(Xopts,{
Xpar <- list()
class(Xpar) <- c('trivial')
Xpar$H = checkIt(HPop, nPatches)
Xpar$kappa= checkIt(kappa, nPatches)
Xpar$season = season
Xpar$trend = trend
Xpar$F_season = F_season
Xpar$F_trend = F_trend
return(Xpar)
})}

Expand Down
82 changes: 31 additions & 51 deletions R/plot-terms.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,39 +4,37 @@
#' @param i the host species index
#' @param clrs a vector of colors
#' @param llty an integer (or integers) to set the `lty` for plotting
#' @param stable a logical: set to FALSE for `orbits` and TRUE for `stable_orbits`
#' @param add_axes a logical: plot axes only if TRUE
#' @param add a logical: plot axes only if FALSE
#'
#' @export
xds_plot_EIR <- function(pars, i=1, clrs="black", llty=1, stable=FALSE, add_axes=TRUE){

tm = pars$outputs$time
xds_plot_EIR <- function(pars, i=1, clrs="black", llty=1, add=FALSE){
times = pars$outputs$time
EIR = get_EIR(pars, i)
if(add_axes==TRUE){
plot(tm, EIR, type = "n",

if(add==FALSE){
plot(times, 0*times, type = "n",
xlab = "Time", ylab = "dEIR", ylim = range(0, EIR))
}
xds_lines_EIR(tm, EIR, pars$nStrata[i], clrs, llty)
xds_lines_EIR(times, EIR, pars$nStrata[i], clrs, llty)
}

#' Add lines for the EIR *vs.* time
#'
#' @param tm the time
#' @param times the time
#' @param EIR the entomological inoculation rate
#' @param nStrata the number of human / host population strata
#' @param clrs a vector of colors
#' @param llty an integer (or integers) to set the `lty` for plotting
#'
#' @export
xds_lines_EIR <- function(tm, EIR, nStrata, clrs="black", llty=1){

xds_lines_EIR <- function(times, EIR, nStrata, clrs="black", llty=1){
if(nStrata==1)
graphics::lines(tm, EIR, col=clrs, lty = llty)
graphics::lines(times, EIR, col=clrs, lty = llty)
if(nStrata>1){
if(length(clrs)==1) clrs=rep(clrs, nStrata)
if(length(llty)==1) llty=rep(llty, nStrata)
for(i in 1:nStrata)
graphics::lines(tm, EIR[,i], col=clrs[i], lty = llty)
graphics::lines(times, EIR[,i], col=clrs[i], lty = llty)
}

}
Expand All @@ -47,38 +45,19 @@ xds_lines_EIR <- function(tm, EIR, nStrata, clrs="black", llty=1){
#' @param i the host species index
#' @param clrs a vector of colors
#' @param llty an integer (or integers) to set the `lty` for plotting
#' @param stable a logical: set to FALSE for `orbits` and TRUE for `stable_orbits`
#' @param add_axes a logical: plot axes only if TRUE
#' @param stable a logical: set to FALSE for `orbits` and FALSE for `stable_orbits`
#' @param add a logical: plot axes only if FALSE
#'
#' @export
xds_plot_aEIR <- function(pars, i=1, clrs="black", llty=1, stable=FALSE, add_axes=TRUE){
vars=with(pars$outputs,if(stable==TRUE){stable_orbits}else{orbits})

tm = vars$terms$time
aEIR = 365*vars$terms$eir[[i]]
if(add_axes==TRUE)
plot(tm, aEIR, type = "n", xlab = "Time", ylab = "aEIR", ylim = range(0, aEIR))
xds_plot_aEIR <- function(pars, i=1, clrs="black", llty=1, stable=FALSE, add=FALSE){
times = pars$outputs$time
EIR = get_EIR(pars, i)

xds_lines_aEIR(tm, aEIR, pars$Hpar[[i]]$nStrata, clrs, llty)
}
aEIR = 365*EIR
if(add==FALSE)
plot(times, 0*times, type = "n", xlab = "Time", ylab = "aEIR", ylim = range(0, aEIR))

#' Add lines for the annualized EIR *vs.* t
#'
#' @param tm the time
#' @param EIR the entomological inoculation rate
#' @param nStrata the number of human / host population strata
#' @param clrs a vector of colors
#' @param llty an integer (or integers) to set the `lty` for plotting
#'
#' @export
xds_lines_aEIR <- function(tm, EIR, nStrata, clrs="black", llty=1){
aeir = 365*EIR
if(nStrata==1) graphics::lines(tm, aeir, col=clrs)
if(nStrata>1){
if (length(clrs)==1) clrs=rep(clrs, nStrata)
for(i in 1:nStrata)
graphics::lines(tm, aeir[,i], col=clrs[i])
}
xds_lines_EIR(times, aEIR, pars$nStrata[i], clrs, llty)
}

#' Plot the prevalence / parasite rate (PR) from a model of human infection and immunity
Expand All @@ -87,38 +66,39 @@ xds_lines_aEIR <- function(tm, EIR, nStrata, clrs="black", llty=1){
#' @param i the host species index
#' @param clrs a vector of colors
#' @param llty an integer (or integers) that specifies `lty` for plotting
#' @param stable a logical: set to FALSE for `orbits` and TRUE for `stable_orbits`
#' @param add_axes a logical: plot axes only if TRUE
#' @param add a logical: plot axes only if FALSE
#'
#' @export
xds_plot_PR = function(pars, i=1, clrs="black", llty=1, stable=FALSE, add_axes=TRUE){
xds_plot_PR = function(pars, i=1, clrs="black", llty=1, add=FALSE){
terms = pars$outputs$orbits$XH[[1]]
times = pars$outputs$time

tm = pars$outputs$time
if(add_axes==TRUE){
plot(tm, 0*tm + 1, type = "n", ylim = c(0,1),
if(add==FALSE){
plot(times, 0*times, type = "n", ylim = c(0,1),
ylab = "Prevalence", xlab = "Time")
}

xds_lines_PR(tm, pars$outputs$orbits$XH[[1]]$true_pr, pars$nStrata[i], clrs, llty)
xds_lines_PR(times, terms$true_pr, pars$nStrata[i], clrs, llty)
}

#' Add lines for the prevalence / parasite rate (PR) from a model of human infection and immunity
#'
#' @param tm the time
#' @param times the time
#' @param PR the computed parasite rate
#' @param nStrata the number of human / host population strata
#' @param clrs a vector of colors
#' @param llty an integer (or integers) that specifies `lty` for plotting
#'
#' @export
xds_lines_PR = function(tm, PR, nStrata, clrs="black", llty=1){
xds_lines_PR = function(times, PR, nStrata, clrs="black", llty=1){

if(nStrata==1) graphics::lines(tm, PR, col=clrs[1], lty = llty[1])
if(nStrata==1) graphics::lines(times, PR, col=clrs[1], lty = llty[1])
if(nStrata>1){
if (length(clrs)==1) clrs=rep(clrs, nStrata)
if (length(llty)==1) llty=rep(llty, nStrata)
for(i in 1:nStrata)
graphics::lines(tm, PR[,i], col=clrs[i], lty = llty[i])
graphics::lines(times, PR[,i], col=clrs[i], lty = llty[i])
}
}

Expand Down
Loading

0 comments on commit 2a42e8c

Please sign in to comment.