Merge pull request #13 from dd-harp/dev

fixing little things

Author: smitdave

.gitignore

@@ -2,5 +2,4 @@
 .Rhistory
 .RData
 .Ruserdata
-.rda
 docs

NAMESPACE

@@ -26,8 +26,8 @@ S3method(make_movie,BQ)
 S3method(make_movie,BQS)
 S3method(make_tiles,BQ)
 S3method(make_tiles,BQS)
-S3method(plot_Psi,BQ)
-S3method(plot_Psi,BQS)
+S3method(plot_all_Psi,BQ)
+S3method(plot_all_Psi,BQS)
 S3method(plot_points,BQ)
 S3method(plot_points,BQS)
 S3method(save_states_L,basicL)
@@ -89,7 +89,7 @@ export(make_Psi_BQS)
 export(make_Psi_xx)
 export(make_Psi_xy)
 export(make_all_graphs)
-export(make_all_graphs_common)
+export(make_common_graphs)
 export(make_convex_hull_i)
 export(make_convex_hulls)
 export(make_demography_BQ)
@@ -109,9 +109,6 @@ export(plot_Kbb)
 export(plot_Kbq)
 export(plot_Kqb)
 export(plot_Kqq)
-export(plot_Psi)
-export(plot_Psi_BQSmod)
-export(plot_Psi_BQmod)
 export(plot_Psi_bb)
 export(plot_Psi_bq)
 export(plot_Psi_bs)
@@ -121,6 +118,9 @@ export(plot_Psi_qs)
 export(plot_Psi_sb)
 export(plot_Psi_sq)
 export(plot_Psi_ss)
+export(plot_all_Psi)
+export(plot_all_Psi_BQ)
+export(plot_all_Psi_BQS)
 export(plot_convex_hulls)
 export(plot_dispersal_G)
 export(plot_dispersal_GG)

R/Psi_matrices.R

@@ -53,9 +53,9 @@ make_Psi_xx = function(S, kF=make_kF_exp(), w=1, stay=0){
 #'
 #' @return the model, a compound [list]
 #' @export
-plot_Psi = function(model, max_pt_sz=2,
+plot_all_Psi = function(model, max_pt_sz=2,
                     min_edge_frac = 0.01, r=.01, arw_lng=0.05, lwd=2){
-  UseMethod("plot_Psi", model)
+  UseMethod("plot_all_Psi", model$Mpar)
 }
 
 #' Visualize the one-bout dispersal matrices for a BQ model
@@ -69,11 +69,12 @@ plot_Psi = function(model, max_pt_sz=2,
 #'
 #' @return the model, a compound [list]
 #' @export
-plot_Psi.BQ = function(model, max_pt_sz=2,
+plot_all_Psi.BQ = function(model, max_pt_sz=2,
                        min_edge_frac = 0.01, r=.01, arw_lng=0.05, lwd=2){
-  with(model,{plot_Psi_BQmod(b,q,Psi_bb, Psi_qb, Psi_bq, Psi_qq,
+  with(model,with(Mpar,{plot_Psi_BQ(b,q,Psi_bb, Psi_qb, Psi_bq, Psi_qq,
                           max_pt_sz=max_pt_sz, min_edge_frac=min_edge_frac,
-                          r=r, arw_lng=arw_lng, lwd=lwd)})}
+                          r=r, arw_lng=arw_lng, lwd=lwd)}))}
+
 
 
 #' Visualize the one-bout dispersal matrices for a BQ model
@@ -92,7 +93,7 @@ plot_Psi.BQ = function(model, max_pt_sz=2,
 #'
 #' @return no visible return value
 #' @export
-plot_Psi_BQmod = function(b, q,
+plot_all_Psi_BQ = function(b, q,
                        Psi_bb, Psi_qb,
                        Psi_bq, Psi_qq,
                        max_pt_sz=2, min_edge_frac = 0.01,
@@ -118,15 +119,15 @@ plot_Psi_BQmod = function(b, q,
 #'
 #' @return the model, a compound [list]
 #' @export
-plot_Psi.BQS = function(model,max_pt_sz=2,
+plot_all_Psi.BQS = function(model,max_pt_sz=2,
                         min_edge_frac = 0.01, r=.01, arw_lng=0.05, lwd=2){
-  with(model,{plot_Psi_BQSmod(b,q,s,
+  with(model,with(Mpar,{plot_Psi_BQS(b,q,s,
                            Psi_bb, Psi_qb, Psi_sb,
                            Psi_bq, Psi_qq, Psi_sq,
                            Psi_bs, Psi_qs, Psi_ss,
                            max_pt_sz=max_pt_sz, min_edge_frac=min_edge_frac,
                            r=r, arw_lng=arw_lng, lwd=lwd)
-  })}
+  }))}
 
 
 #' Visualize the one-bout dispersal matrices for a BQS model
@@ -151,7 +152,7 @@ plot_Psi.BQS = function(model,max_pt_sz=2,
 #'
 #' @return no visible return value
 #' @export
-plot_Psi_BQSmod = function(b,q,s,
+plot_all_Psi_BQS = function(b,q,s,
                         Psi_bb, Psi_qb, Psi_sb,
                         Psi_bq, Psi_qq, Psi_sq,
                         Psi_bs, Psi_qs, Psi_ss,
@@ -186,7 +187,7 @@ plot_Psi_BQSmod = function(b,q,s,
 #' @export
 plot_Psi_bb = function(b, q, Psi_bb,
                        max_pt_sz=2, min_edge_frac = 0.01,
-                       r=.01, arw_lng=0.05, lwd=2){
+                       r=.02, arw_lng=0.05, lwd=2){
 
   ## b to b
   frame_bq(b,q, mtl=expression(Psi[b %<-% b]))
@@ -213,9 +214,9 @@ plot_Psi_bq = function(b,q, Psi_bq,
                        max_pt_sz=2, min_edge_frac = 0.01,
                        r=.01, arw_lng=0.05, lwd=2){
   frame_bq(b, q, mtl = expression(Psi * scriptstyle(b %<-% q)))
-  add_points_q(q, max_pt_sz = 0.6)
   add_arrows_xy(q, b, Psi_bq, min_edge_frac=min_edge_frac,
                 r=r, arw_lng=arw_lng, lwd=lwd, clr="tomato")
+  add_points_q(q, max_pt_sz = 0.3)
   add_points_b(b, rowSums(Psi_bq), max_pt_sz = max_pt_sz)
   return(invisible())
 }
@@ -264,9 +265,9 @@ plot_Psi_qb = function(b, q, Psi_qb,
 
   ## b to q
   frame_bq(b, q, mtl = expression(Psi*scriptstyle(q %<-% b)))
-  add_points_b(b, max_pt_sz=0.6)
   add_arrows_xy(b, q, Psi_qb, min_edge_frac=min_edge_frac,
                 r=r, arw_lng=arw_lng, lwd=lwd, clr = "skyblue")
+  add_points_b(b, max_pt_sz=0.3)
   add_points_q(q, rowSums(Psi_qb), max_pt_sz=max_pt_sz)
   return(invisible())
 }

R/adult-BQS.R

@@ -126,7 +126,7 @@ setup_dispersal_BQS = function(model, opts = list(),
     model$Mpar$setup$ws = ws
     model$Mpar$setup$stayB=stayB
     model$Mpar$setup$stayQ=stayQ
-    model$Ppar$setup$stayS=stayS
+    model$Mpar$setup$stayS=stayS
     model = make_Psi_BQS(model)
     return(model)
   })})
@@ -214,7 +214,7 @@ make_demography_BQS = function(model){
     model$Mpar$Msq = Psi_sq %*% diag(pQ*(sigf*psiQ + sigq*(1-psiQ)), nq)
     # from s
     model$Mpar$Mbs = Psi_bs %*% diag(pS*psiS, ns)
-    model$Mpar$Mqs = 0*t(Msq)
+    model$Mpar$Mqs = 0*t(model$Mpar$Msq)
     model$Mpar$Mss = Psi_ss %*% diag(pS*(1-psiS), ns)
     # recently emerged adults
     model$Mpar$Mbl = Psi_bq %*% diag(pQ*(1-sigL), nq)

R/graphs.R

@@ -36,7 +36,7 @@ make_graph_obj = function(M, type ="b", tag = ""){
 #'
 #' @returns a ramp.micro model object
 #' @export
-make_all_graphs_common = function(model){with(model,{
+make_common_graphs = function(model){with(model,{
   model$graphs <- list()
   model$graphs$Kbb_net <- make_graph_obj(KGV$Kbb, "b", expression(K*scriptstyle(b%->%b)))
   model$graphs$Kqq_net <- make_graph_obj(KGV$Kqq, "q", expression(K*scriptstyle(q%->%q)))
@@ -70,7 +70,7 @@ make_all_graphs = function(model){UseMethod("make_all_graphs",model)}
 #' @returns a ramp.micro model object
 #' @export
 make_all_graphs.BQ = function(model){
-  model = make_all_graphs_common(model)
+  model = make_common_graphs(model)
   BQ <- with(model$steady$M, diag(as.vector(c(B, Q))))
   bigMM <- model$Mpar$bigM %*% BQ
   model$Mpar$bigMM <- bigMM
@@ -88,7 +88,7 @@ make_all_graphs.BQ = function(model){
 #' @returns a ramp.micro model object
 #' @export
 make_all_graphs.BQS = function(model){
-  model = make_all_graphs_common(model)
+  model = make_common_graphs(model)
   BQS <- with(model$steady$M, diag(as.vector(c(B, Q, S))))
   bigMM <- model$Mpar$bigM %*% BQS
   model$Mpar$bigMM <- bigMM

R/kernels.R

@@ -1,12 +1,31 @@
 
-#' Make an exponential function to weight points by distance
+#' Make an exponential function for weight by distance
+#'
+#' @description This returns a function of the form
+#' \deqn{F_w (d, \omega=1) = \omega_j e^{-k \left( \frac{d_{i,j}}{s}\right)^\gamma}}
+#' where \eqn{s} and \eqn{\gamma} are shape parameters, \eqn{k} is the rate
+#' parameter, and \eqn{\omega} is a weight.
+#'
+#' In effect, \eqn{s} is the location of a shoulder, and for \eqn{\gamma>1}, the decay is
+#' slower for \eqn{d<s}.
+#'
+#' The function returned accepts \eqn{\omega} as
+#' an optional argument so that it can be passed at the time of simulation.
+#'
+#' By default, the function returns scaled values -- the maximum is 1.
 #'
 #' @param k decay by distance
 #' @param s a scale parameter
 #' @param gamma a shape parameter
 #'
 #' @return a function
 #' @export
+#' @examples
+#' kF1 = make_kF_exp(k=1, s=1, gamma=1.5)
+#' kF2 = make_kF_exp(k=2, s=0.1, gamma=2)
+#' dd = seq(0, 2, by = 0.01)
+#' plot(dd, kF1(dd), type = "l", ylab = "Weight", xlab = "Distance")
+#' lines(dd, kF2(dd))
 make_kF_exp = function(k=1, s=2, gamma=1){
   return(function(dd, w=1){
     wij = w*(exp(-k*(dd/s)^gamma))
@@ -32,15 +51,16 @@ make_kF_pwr = function(delta=1, s=1){
 #'
 #' @param p the weight on the power function
 #' @param k decay by distance
-#' @param s a scale parameter
+#' @param s1 a scale parameter
+#' @param s2 a scale parameter
 #' @param gamma a shape parameter
 #' @param delta the power on distance
 #'
 #' @return a function
 #' @export
-make_kF_mix = function(p=0.001, k=1, s=2, gamma=1, delta=1){
+make_kF_mix = function(p=0.001, k=1, s1=1, s2=1, gamma=1, delta=1){
   return(function(dd, w=1){
-    wij = (1-p)*w*(exp(-k*(dd/s)^gamma)) + p*w/(dd+s)^delta
+    wij = (1-p)*w*(exp(-k*(dd/s1)^gamma)) + p*w/(dd+s2)^delta
     wij/max(wij)
   })
 }

R/plot_points.R

@@ -192,9 +192,11 @@ add_points_s = function(s, wts=1, pw=1, max_pt_sz=1, clr="olivedrab2"){
 #' @return invisible(NULL)
 #' @export
 add_points_bb = function(b, M, pw=1, max_pt_sz=2, colA="#cc444b66", colB="#cc444bCC"){
-  add_points_b(b, as.vector(rowSums(M)), pw, max_pt_sz, colA)
+  wts1 <- as.vector(rowSums(M))
+  add_points_b(b, wts1, pw, max_pt_sz, colA)
   diag(M) <- 0
-  add_points_b(b, as.vector(rowSums(M)), pw, max_pt_sz, colB)
+  wts2 <- as.vector(rowSums(M))
+  add_points_b(b, wts2, pw, max_pt_sz*max(wts2)/max(wts1), colB)
   return(invisible())
 }
 
@@ -210,9 +212,11 @@ add_points_bb = function(b, M, pw=1, max_pt_sz=2, colA="#cc444b66", colB="#cc444
 #' @return invisible(NULL)
 #' @export
 add_points_qq = function(q, M, pw=1, max_pt_sz=2, colA="skyblue", colB="skyblue3"){
-  add_points_q(q, as.vector(rowSums(M)), pw, max_pt_sz, colA)
+  wts1 <- as.vector(rowSums(M))
+  add_points_q(q, wts1, pw, max_pt_sz, colA)
   diag(M) <- 0
-  add_points_q(q, as.vector(rowSums(M)), pw, max_pt_sz, colB)
+  wts2 <- as.vector(rowSums(M))
+  add_points_q(q, wts2, pw, max_pt_sz*max(wts2)/max(wts1), colB)
   return(invisible())
 }
 

R/setup_model.R

@@ -9,6 +9,7 @@
 #' @param kFs a kernel shape for sugar site searching
 #' @param Mname the adult model name
 #' @param Lname the aquatic model name
+#' @param dispersal_opts a [list] to
 #' @param bionomic_opts a [list] to overwrite defaults
 #' @param aquatic_opts a [list] to overwrite defaults
 #' @param M0_opts options to overwrite defaults
@@ -17,8 +18,10 @@
 #'
 #' @return a [list] defining a BQ-class adult model
 #' @export
-setup_model = function(b, q, s=c(), kFb, kFq, kFs = NULL,
+setup_model = function(b, q, s=c(),
+                       kFb=NULL, kFq=NULL, kFs=NULL,
                        Mname="BQ", Lname="basicL",
+                       dispersal_opts = list(),
                        bionomic_opts = list(),
                        aquatic_opts = list(),
                        M0_opts = list(),
@@ -35,7 +38,8 @@ setup_model = function(b, q, s=c(), kFb, kFq, kFs = NULL,
   model$nq = length(q[,1])
   if(!is.null(s)) model$ns = length(s[,1])
 
-  dispersal_opts = list(kFb=kFb, kFq=kFq)
+  if(!is.null(kFb)) dispersal_opts$kFb = kFb
+  if(!is.null(kFq)) dispersal_opts$kFq = kFq
   if(!is.null(kFs)) dispersal_opts$kFs = kFs
 
   Mpar = list()

_pkgdown.yml

@@ -9,11 +9,7 @@ navbar:
       href: articles/point_sets.html
     - text: Kernels
       href: articles/kernels.html
-    - text: Adult Mosquito Models
-      href: articles/adult.html
-    - text: Aquatic Mosquito Models
-      href: articles/aquatic.html
-    - text: Setting Up Models
+    - text: Building a Model
       href: articles/models.html
     - text: Simulation
       href: articles/simulation.html
@@ -33,6 +29,10 @@ navbar:
       href: articles/dispersal.html
     - text: Communitites
       href: articles/community.html
+    - text: Modularity - Adult Mosquito Models
+      href: articles/adult.html
+    - text: Modularity - Aquatic Mosquito Models
+      href: articles/aquatic.html
   - text: Functions
     href: reference/index.html
   right:
@@ -281,18 +281,18 @@ reference:
   - plot_Psi_sb
   - plot_Psi_sq
   - plot_Psi_ss
-  - plot_Psi
-  - plot_Psi.BQ
-  - plot_Psi_BQmod
-  - plot_Psi.BQS
-  - plot_Psi_BQSmod
+  - plot_all_Psi
+  - plot_all_Psi.BQ
+  - plot_all_Psi_BQ
+  - plot_all_Psi.BQS
+  - plot_all_Psi_BQS
 - title: Graphs
   desc: |
      Make Graphs
   contents:
   - make_graph_obj
+  - make_common_graphs
   - make_all_graphs
-  - make_all_graphs_common
   - make_all_graphs.BQ
   - make_all_graphs.BQS
 - title: Metapopulations