Merge pull request #153 from dd-harp/dev

Bugfixes for multi-species upgrade

NAMESPACE

@@ -228,8 +228,6 @@ S3method(update_inits_X,SIP)
 S3method(update_inits_X,SIS)
 S3method(update_inits_X,hMoI)
 S3method(update_inits_X,trace)
-S3method(xde_lines_X,SIP)
-S3method(xde_lines_X,SIS)
 S3method(xde_plot_X,SIP)
 S3method(xde_plot_X,SIS)
 S3method(xde_solve,aqua)
@@ -474,7 +472,8 @@ export(xDE_diffeqn_mosy)
 export(xde_lines_EIR)
 export(xde_lines_M)
 export(xde_lines_PR)
-export(xde_lines_X)
+export(xde_lines_X_SIP)
+export(xde_lines_X_SIS)
 export(xde_lines_YZ)
 export(xde_lines_YZ_fracs)
 export(xde_lines_aEIR)

R/adult-RM.R

@@ -54,7 +54,7 @@ F_eggs.RM <- function(t, y, pars, s) {
 #' @export
 dMYZdt.RM_ode <- function(t, y, pars, s) {
   Lambda = pars$Lambda[[s]]
-  kappa = pars$kappa [[s]]
+  kappa = pars$kappa[[s]]
 
   with(pars$ix$MYZ[[s]],{
     M <- y[M_ix]
@@ -83,7 +83,7 @@ dMYZdt.RM_ode <- function(t, y, pars, s) {
 dMYZdt.RM_dde <- function(t, y, pars, s){
 
   Lambda = pars$Lambda[[s]]
-  kappa = pars$kappa [[s]]
+  kappa = pars$kappa[[s]]
 
   with(pars$ix$MYZ[[s]],{
     M <- y[M_ix]
@@ -110,6 +110,7 @@ dMYZdt.RM_dde <- function(t, y, pars, s){
 
       Omega <- make_Omega(g, sigma, calK, nPatches)
       Omega_eip <- make_Omega(g_eip, sigma_eip, calK, nPatches)
+
       dMdt <- Lambda - (Omega %*% M)
       dPdt <- f*(M - P) - (Omega %*% P)
       dYdt <- f*q*kappa*(M - Y) - (Omega %*% Y)

R/aquatic-trace.R

@@ -15,8 +15,7 @@ LBionomics.trace <- function(t, y, pars, s) {
 #' @return a [numeric] vector of length `nHabitats`
 #' @export
 F_alpha.trace <- function(t, y, pars, s) {
-  Lp = pars$Lpar[[s]]
-  with(Lp, Lt(t, Lp))
+  pars$Lpar[[s]]$Lt(t)
 }
 
 #' @title Derivatives for aquatic stage mosquitoes
@@ -60,7 +59,8 @@ make_Lpar_trace = function(nHabitats, Lopts=list(), Lambda=1000, Lt = NULL){
     Lpar = list()
     class(Lpar) <- "trace"
     Lpar$Lambda = checkIt(Lambda, nHabitats)
-    if(is.null(Lt)) Lt = function(t, Lpar){Lpar$Lambda}
+    #if(is.null(Lt)) Lt = function(t, Lpar){Lpar$Lambda}
+    if(is.null(Lt)) Lt = function(t){Lambda}
     Lpar$Lt = Lt
     return(Lpar)
 })}
@@ -93,8 +93,8 @@ make_parameters_L_trace <- function(pars, Lambda, Lt=NULL) {
   stopifnot(is.numeric(Lambda))
   Lpar <- list()
   class(Lpar) <- 'trace'
-  Lpar$Lambda <- Lambda
-  if(is.null(Lt)) Lt = function(t, Lpar){Lpar$Lambda}
+  Lpar$Lambda = checkIt(Lambda, pars$nHabitats)
+  if(is.null(Lt)) Lt = function(t){Lambda}
   Lpar$Lt = Lt
   pars$Lpar[[1]] <- Lpar
   return(pars)

R/compute.R

@@ -19,11 +19,13 @@ compute_terms <- function(varslist, deout, pars, s, i) {
 #' @export
 compute_terms.xde <- function(varslist, deout, pars, s, i) {
   time = deout[,1]
+  eir = c()
+  kappa = c()
   for (ix in 1:length(time)){
-    yt = deout[i,-1]
-    pars = Transmission(time[i], yt, pars)
-    eir = pars$EIR[[1]]
-    kappa = pars$kappa[[1]]
+    yt = deout[ix,-1]
+    pars = Transmission(time[ix], yt, pars)
+    eir = c(eir, pars$EIR[[1]])
+    kappa = c(kappa, pars$kappa[[1]])
   }
   ni = compute_NI(deout, pars, i)
   fqZ = compute_fqZ(deout, pars, s)
@@ -56,10 +58,11 @@ compute_terms.cohort <- function(varslist, deout, pars, s, i) {
 #' @export
 compute_terms.human<- function(varslist, deout, pars, s, i) {
   time = deout[,1]
+  eir = c()
   for (ix in 1:length(time)){
     yt = deout[i,-1]
     pars = Transmission(time[i], yt, pars)
-    eir = pars$EIR[[1]]
+    eir = c(eir, pars$EIR[[1]])
   }
   ni = compute_NI(deout, pars)
   fqZ = compute_fqZ(deout, pars)

R/human-SIP.R

@@ -250,24 +250,27 @@ get_inits_X.SIP <- function(pars, i){with(pars$Xinits[[i]],{
 #'
 #' @inheritParams xde_plot_X
 #' @export
-xde_plot_X.SIP = function(pars, i, clrs=c("darkblue", "darkred", "darkgreen"), llty=1, stable=FALSE, add_axes=TRUE){
+xde_plot_X.SIP = function(pars, i=1, clrs=c("darkblue", "darkred", "darkgreen"), llty=1, stable=FALSE, add_axes=TRUE){
   vars=with(pars$outputs,if(stable==TRUE){stable_orbits}else{orbits})
 
   if(add_axes==TRUE)
     with(vars$XH[[i]],
          plot(time, 0*time, type = "n", ylim = c(0, max(H)),
               ylab = "# Infected", xlab = "Time"))
 
-  xde_lines_X(vars$XH[[i]], pars, clrs, llty)
+  xde_lines_X_SIP(vars$XH[[i]], pars, clrs, llty)
 }
 
 
 #' Add lines for the density of infected individuals for the SIP model
 #'
-#' @inheritParams xde_lines_X
+#' @param XH a list with the outputs of parse_deout_X_SIS
+#' @param pars a list that defines an `exDE` model (*e.g.*,  generated by `xde_setup()`)
+#' @param clrs a vector of colors
+#' @param llty an integer (or integers) to set the `lty` for plotting
 #'
 #' @export
-xde_lines_X.SIP = function(XH, pars, clrs=c("darkblue", "darkred", "darkgreen"), llty=1){
+xde_lines_X_SIP = function(XH, pars, clrs=c("darkblue", "darkred", "darkgreen"), llty=1){
   with(XH,{
     if(pars$nStrata==1) {
       lines(time, S, col=clrs[1], lty = llty[1])

R/human-SIS.R

@@ -222,35 +222,39 @@ get_inits_X.SIS <- function(pars, i){
 #'
 #' @inheritParams xde_plot_X
 #' @export
-xde_plot_X.SIS = function(pars, i, clrs=c("darkblue","darkred"), llty=1, stable=FALSE, add_axes=TRUE){
+xde_plot_X.SIS = function(pars, i=1, clrs=c("darkblue","darkred"), llty=1, stable=FALSE, add_axes=TRUE){
   vars=with(pars$outputs,if(stable==TRUE){stable_orbits}else{orbits})
 
   if(add_axes==TRUE)
     with(vars$XH[[i]],
          plot(time, 0*time, type = "n", ylim = c(0, max(H)),
               ylab = "# Infected", xlab = "Time"))
 
-  xde_lines_X(vars$XH[[i]], pars, clrs, llty)
+  xde_lines_X_SIS(vars$XH[[i]], pars, clrs, llty)
 }
 
 
 #' Add lines for the density of infected individuals for the SIS model
 #'
-#' @inheritParams xde_lines_X
+#' @param XH a list with the outputs of parse_deout_X_SIS
+#' @param pars a list that defines an `exDE` model (*e.g.*,  generated by `xde_setup()`)
+#' @param clrs a vector of colors
+#' @param llty an integer (or integers) to set the `lty` for plotting
 #'
 #' @export
-xde_lines_X.SIS = function(XH, pars, clrs=c("darkblue","darkred"), llty=1){
+xde_lines_X_SIS = function(XH, pars, clrs=c("darkblue","darkred"), llty=1){
   with(XH,{
     if(pars$nStrata==1) {
       lines(time, S, col=clrs[1], lty = llty[1])
       lines(time, I, col=clrs[2], lty = llty[1])
     }
     if(pars$nStrata>1){
-      if (length(clrs)==1) clrs=matrix(clrs, 2, pars$nStrata)
+      if (length(clrs)==2) clrs=matrix(clrs, 2, pars$nStrata)
       if (length(llty)==1) llty=rep(llty, pars$nStrata)
+
       for(i in 1:pars$nStrata){
-        lines(time, S[,i], col=clrs[i,1], lty = llty[i])
-        lines(time, I[,i], col=clrs[i,2], lty = llty[i])
+        lines(time, S[,i], col=clrs[1,i], lty = llty[i])
+        lines(time, I[,i], col=clrs[2,i], lty = llty[i])
       }
     }
   })}

R/human-interface.R

@@ -144,19 +144,6 @@ HTC <- function(pars, i) {
 #' @param add_axes a logical: plot axes only if TRUE
 #'
 #' @export
-xde_plot_X = function(pars, i, clrs="black", llty=1, stable=FALSE, add_axes=TRUE){
+xde_plot_X = function(pars, i=1, clrs="black", llty=1, stable=FALSE, add_axes=TRUE){
   UseMethod("xde_plot_X", pars$Xpar[[i]])
 }
-
-#' Add lines for basic outputs of epidemiological models
-#'
-#' @param XH a list with the outputs of `exDE::parse_deout()`
-#' @param pars a list that defines an `exDE` model (*e.g.*,  generated by `xde_setup()`)
-#' @param clrs a vector of colors
-#' @param llty an integer (or integers) to set the `lty` for plotting
-#'
-#' @export
-xde_lines_X = function(XH, pars, clrs="black", llty=1){
-  UseMethod("xde_lines_X", pars$Xpar)
-}
-

R/plot-MYZ.R

@@ -2,20 +2,21 @@
 #' Plot adult mosquito population density
 #'
 #' @param pars a list that defines an `exDE` model (*e.g.*,  generated by `xde_setup()`)
+#' @param s the vector 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
 #'
 #' @export
-xde_plot_M = function(pars, clrs="darkblue", llty=1, stable=FALSE, add_axes=TRUE){
+xde_plot_M = function(pars, s=1, clrs="darkblue", llty=1, stable=FALSE, add_axes=TRUE){
   vars=with(pars$outputs,if(stable==TRUE){stable_orbits}else{orbits})
 
-  if(add_axes == TRUE) with(vars$MYZ,
+  if(add_axes == TRUE) with(vars$MYZ[[s]],
                             plot(time, 0*time, type = "n", ylim = range(0,max(M)),
                                  ylab = "Mosquito Density", xlab = "Time"))
 
-  xde_lines_M(vars$MYZ, pars, clrs, llty)
+  xde_lines_M(vars$MYZ[[s]], pars, clrs, llty)
 }
 
 #' Add lines for adult mosquito population density
@@ -41,22 +42,23 @@ xde_lines_M = function(MYZ, pars, clrs="darkblue", llty=1){
 #' Plot the density of infected and infective mosquitoes
 #'
 #' @param pars a list that defines an `exDE` model (*e.g.*,  generated by `xde_setup()`)
+#' @param s the vector species index
 #' @param Yclrs a vector of colors for infected mosquitoes
 #' @param Zclrs a vector of colors for infective mosquitoes
 #' @param llty an integer (or integers) to set the `lty` for plotting
 #' @param stable set to FALSE for `orbits` and TRUE for `stable_orbits`
 #' @param add_axes to plot axes only if TRUE
 #'
 #' @export
-xde_plot_YZ = function(pars, Yclrs = "purple", Zclrs="darkred", llty=1, stable=FALSE, add_axes=TRUE){
+xde_plot_YZ = function(pars, s=1, Yclrs = "purple", Zclrs="darkred", llty=1, stable=FALSE, add_axes=TRUE){
   vars=with(pars$outputs,if(stable==TRUE){stable_orbits}else{orbits})
 
   if(add_axes == TRUE)
-    with(vars$MYZ,
+    with(vars$MYZ[[s]],
          plot(time, 0*time, type = "n", ylim = range(0,max(Y)),
               ylab = "Mosquito Density", xlab = "Time"))
 
-  xde_lines_YZ(vars$MYZ, pars, Yclrs, Zclrs, llty)
+  xde_lines_YZ(vars$MYZ[[s]], pars, Yclrs, Zclrs, llty)
 }
 
 #' Add lines for the density of infected and infective mosquitoes
@@ -89,22 +91,23 @@ xde_lines_YZ = function(MYZ, pars, Yclrs="purple", Zclrs = "darkred", llty=1){
 #' Plot the fraction of infected and infective mosquitoes
 #'
 #' @param pars a list that defines an `exDE` model (*e.g.*,  generated by `xde_setup()`)
+#' @param s the vector species index
 #' @param Yclrs a vector of colors for infected mosquitoes
 #' @param Zclrs a vector of colors for infective mosquitoes
 #' @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 to plot axes only if TRUE
 #'
 #' @export
-xde_plot_YZ_fracs = function(pars, Yclrs = "purple", Zclrs = "darkred", llty=1, stable=FALSE, add_axes=TRUE){
+xde_plot_YZ_fracs = function(pars, s=1, Yclrs = "purple", Zclrs = "darkred", llty=1, stable=FALSE, add_axes=TRUE){
   vars=with(pars$outputs,if(stable==TRUE){stable_orbits}else{orbits})
 
   if(add_axes == TRUE)
-    with(vars$MYZ,
+    with(vars$MYZ[[s]],
          plot(time, 0*time, type = "n", ylim = range(0,1),
               ylab = "Fraction Infected", xlab = "Time"))
 
-  xde_lines_YZ_fracs(vars$MYZ, pars, Yclrs, Zclrs, llty)
+  xde_lines_YZ_fracs(vars$MYZ[[s]], pars, Yclrs, Zclrs, llty)
 }
 
 #' Add lines for the fraction of infected and infective mosquitoes

R/setup.R

@@ -25,7 +25,7 @@
 #' @param Lopts a list to configure the L model
 #' @return a [list]
 #' @export
-xde_setup = function(modelName,
+xde_setup = function(modelName = "unnamed",
 
                      # Dynamical Components
                      MYZname = "RM",
@@ -117,7 +117,7 @@ xde_setup = function(modelName,
 #' @param kappa values -- net infectivity to force adult infection dynamics
 #' @return a [list]
 #' @export
-xde_setup_mosy = function(modelName,
+xde_setup_mosy = function(modelName = "unnamed",
 
                      # Dynamical Components
                      MYZname = "basicM",
@@ -186,7 +186,7 @@ xde_setup_mosy = function(modelName,
 #' @param LSMname is a character string defining a LSM model
 #' @return a [list]
 #' @export
-xde_setup_aquatic = function(modelName,
+xde_setup_aquatic = function(modelName = "unnamed",
                      nHabitats = 1,
                      nVectors = 1,
                      Lname = "basic",
@@ -235,7 +235,7 @@ xde_setup_aquatic = function(modelName,
 #' @param TaRopts are the options to setup TaR
 #' @return a [list]
 #' @export
-xde_setup_human = function(modelName,
+xde_setup_human = function(modelName = "unnamed",
 
                      # Dynamical Components
                      Xname = "SIS",
@@ -286,16 +286,17 @@ xde_setup_human = function(modelName,
 }
 
 #' @title Set up a model for xde_diffeqn_cohort
-#' @param modelName is a name for the model (arbitrary)
 #' @param F_eir is a function F_eir(t, pars) that returns the daily FoI
+#' @param modelName is a name for the model (arbitrary)
 #' @param Xname is a character string defining a X model
 #' @param HPop is the number of humans in each patch
 #' @param searchB is a vector of search weights for blood feeding
 #' @param Xopts a list to configure the X model
 #' @param Hopts a list to configure the H model
 #' @return a [list]
 #' @export
-xde_setup_cohort = function(modelName, F_eir,
+xde_setup_cohort = function(F_eir,
+                           modelName = "unnamed",
 
                            # Dynamical Components
                            Xname = "SIS",

R/transmission.R

@@ -90,6 +90,6 @@ F_kappa <- function(t, y, pars, beta, i) {
 #' @export
 compute_beta = function(H, wts_f, TaR){
   W <- as.vector(TaR %*% (wts_f*H))
-  beta <- diag(wts_f, length(H)) %*% t(TaR) %*% diag(1/W, dim(TaR)[1])
+  beta <- diag(wts_f, length(H)) %*% t(TaR) %*% diag(1/W, length(W))
   return(beta)
 }

_pkgdown.yml

@@ -317,7 +317,6 @@ reference:
   - update_inits_X
   - HTC
   - xde_plot_X
-  - xde_lines_X
 - subtitle: trace
   desc: |
     Specialized methods for a human trace model to pass kappa as a parameter
@@ -377,7 +376,7 @@ reference:
   - make_parameters_X_SIS
   - HTC.SIS
   - xde_plot_X.SIS
-  - xde_lines_X.SIS
+  - xde_lines_X_SIS
 - subtitle: SIP
   desc: |
     Specialized methods for the SIP (Susceptible-Infected-Prophylaxis) model of human dynamics.
@@ -399,7 +398,7 @@ reference:
   - make_parameters_X_SIP
   - HTC.SIP
   - xde_plot_X.SIP
-  - xde_lines_X.SIP
+  - xde_lines_X_SIP
 - title: Human Population Dynamics
   desc: |
     Generic methods for the human demography and aging