Merge pull request #156 from dd-harp/dev

Moving towards a final version of ramp.xds

NAMESPACE

@@ -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)

R/adult-basicM.R

@@ -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)
+})}
 
 
 

R/adult-interface.R

@@ -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`.
@@ -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)
+}

R/adult-si.R

@@ -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

R/adult-trivial.R

@@ -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)
 }
 
@@ -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
@@ -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
@@ -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)
   })}
 

R/aquatic-basicL.R

@@ -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]

R/aquatic-trivial.R

@@ -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)

R/human-trivial.R

@@ -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)
 }
 
@@ -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)
 })}
 

R/plot-terms.R

@@ -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)
   }
 
 }
@@ -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
@@ -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])
   }
 }