Merge pull request #14 from dd-harp/dev

minor fixes

Author: smitdave

NAMESPACE

@@ -145,6 +145,8 @@ export(setup_model)
 export(steady_state)
 export(stretch_convex_hull)
 export(unif_xy)
+importFrom(deldir,deldir)
+importFrom(deldir,tile.list)
 importFrom(igraph,E)
 importFrom(igraph,cluster_fast_greedy)
 importFrom(igraph,cluster_walktrap)

R/K_matrices.R

@@ -28,7 +28,7 @@ make_Kbq = function(model, Tmax){
 #' @return the model, a compound [list]
 #' @export
 make_Kbb = function(model){
-  model$KGV$Kbb = with(model$KGV, Kqb %*% Kbq)
+  model$KGV$Kbb = with(model$KGV, Kbq %*% Kqb)
   return(model)
 }
 
@@ -39,7 +39,7 @@ make_Kbb = function(model){
 #' @return the model, a compound [list]
 #' @export
 make_Kqq = function(model){
-  model$KGV$Kqq = with(model$KGV, Kbq %*% Kqb)
+  model$KGV$Kqq = with(model$KGV, Kqb %*% Kbq)
   return(model)
 }
 
@@ -188,10 +188,10 @@ plot_Kqb = function(model, max_pt_sz=2,
                     clr_K="#4361eeCC", clr_b='red', clr_q ='darkblue'){
   with(model,with(Mpar,{
     frame_bq(b, q, mtl = expression(K*scriptstyle(q%<-%b)))
-    if(exists("s")) add_points_s(s, max_pt_sz=0.5)
     add_arrows_xy(b, q, KGV$Kqb, min_edge_frac=min_edge_frac,
                   r=r, arw_lng=arw_lng, lwd=lwd, clr=clr_K)
-    add_points_b(b, clr=clr_b, max_pt_sz=0.7)
+    with(model, if(exists("s")) add_points_s(s, max_pt_sz=0.3))
+    add_points_b(b, clr=clr_b, max_pt_sz=0.3)
     add_points_qq(q, KGV$Kqb, max_pt_sz=max_pt_sz, colA=clr_q)
   }))
   return(invisible())
@@ -216,11 +216,10 @@ plot_Kbq = function(model, max_pt_sz=2,
                     clr_K="#fe5f55CC", clr_b='darkred', clr_q="#858ae399"){
   with(model,with(Mpar,{
     frame_bq(b, q, mtl = expression(K*scriptstyle(b%<-%q)))
-    if(exists("s")) add_points_s(s, max_pt_sz=0.5)
     add_arrows_xy(q, b, KGV$Kbq, min_edge_frac=min_edge_frac,
                   r=r, arw_lng=arw_lng, lwd=lwd, clr=clr_K)
-    with(model, if(exists("s")) add_points_s(s, max_pt_sz=0.7))
-    add_points_q(q, max_pt_sz=0.7, clr=clr_q)
+    with(model, if(exists("s")) add_points_s(s, max_pt_sz=0.3))
+    add_points_q(q, max_pt_sz=0.3, clr=clr_q)
     add_points_bb(b, KGV$Kbq, max_pt_sz=max_pt_sz, colB=clr_b)
   }))
   return(invisible())
@@ -250,8 +249,8 @@ plot_Kbb = function(model, max_pt_sz=2,
          frame_bq(b, q, mtl = expression(K*scriptstyle(b %<-%b)))
          add_arrows_xx(b, KGV$Kbb, min_edge_frac=min_edge_frac,
                        r=r, arw_lng=arw_lng, lwd=lwd, arw_clr=arw_clr, seg_clr=seg_clr)
-         with(model, if(exists("s")) add_points_s(s, max_pt_sz=0.7))
-         add_points_q(q, max_pt_sz=0.7, clr=clr_q)
+         with(model, if(exists("s")) add_points_s(s, max_pt_sz=0.3))
+         add_points_q(q, max_pt_sz=0.3, clr=clr_q)
          add_points_bb(b, KGV$Kbb, max_pt_sz=max_pt_sz, colA=arw_clr, colB=clr_b)
        }))
   return(invisible())
@@ -278,10 +277,10 @@ plot_Kqq = function(model, max_pt_sz=2,
                     clr_q="#858ae399", clr_b="#cc444bCC"){
   with(model,with(Mpar,{
     frame_bq(b, q, mtl = expression(K*scriptstyle(q %<-%q)))
-    with(model, if(exists("s")) add_points_s(s, max_pt_sz=0.7))
     add_arrows_xx(q, KGV$Kqq, min_edge_frac=min_edge_frac,
                   r=r, arw_lng=arw_lng, lwd=lwd, arw_clr=arw_clr, seg_clr=seg_clr)
-    add_points_b(b, max_pt_sz=0.7, clr=clr_b)
+    with(model, if(exists("s")) add_points_s(s, max_pt_sz=0.7))
+    add_points_b(b, max_pt_sz=0.3, clr=clr_b)
     add_points_qq(q, KGV$Kqq, max_pt_sz=max_pt_sz, colA=arw_clr, colB=clr_q)
   }))
   return(invisible())

R/Psi_matrices.R

@@ -71,7 +71,7 @@ plot_all_Psi = function(model, max_pt_sz=2,
 #' @export
 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,with(Mpar,{plot_Psi_BQ(b,q,Psi_bb, Psi_qb, Psi_bq, Psi_qq,
+  with(model,with(Mpar,{plot_all_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)}))}
 
@@ -121,7 +121,7 @@ plot_all_Psi_BQ = function(b, q,
 #' @export
 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,with(Mpar,{plot_Psi_BQS(b,q,s,
+  with(model,with(Mpar,{plot_all_Psi_BQS(b,q,s,
                            Psi_bb, Psi_qb, Psi_sb,
                            Psi_bq, Psi_qq, Psi_sq,
                            Psi_bs, Psi_qs, Psi_ss,

R/add_arrows.R

@@ -13,7 +13,7 @@
 #'
 #' @return invisible(NULL)
 #' @export
-add_arrows_xy = function(xy_launch, xy_land, M, min_edge_frac=0.95,
+add_arrows_xy = function(xy_launch, xy_land, M, min_edge_frac=0.01,
                          r=0, arw_lng=0.1, lwd=2, lamp=1, clr="darkgreen"){
   n1 = dim(xy_launch)[1]
   n2 = dim(xy_land)[1]
@@ -40,7 +40,7 @@ add_arrows_xy = function(xy_launch, xy_land, M, min_edge_frac=0.95,
 #'
 #' @return invisible(NULL)
 #' @export
-add_arrows_xx = function(xy, M, min_edge_frac=.99, r=0, arw_lng=.1, lwd=5, lamp=1,
+add_arrows_xx = function(xy, M, min_edge_frac=.01, r=0, arw_lng=.1, lwd=5, lamp=1,
                          arw_clr = "darkgreen", seg_clr= "#CCCCCC"){
   Mtot = M + t(M)
   Mfrac = M/Mtot

R/convex_hulls.R

@@ -65,7 +65,7 @@ plot_convex_hulls = function(net, stretch=1.1, lwd=2){
   n = length(net$convex_hulls)
   for(i in 1:n){
     with(net$convex_hulls[[i]],{
-      sxy = stretchHull(xy, stretch)
+      sxy = stretch_convex_hull(xy, stretch)
       polygon(sxy[,1], sxy[,2], border=clr, lwd=lwd)
     })
   }

R/egg_laying.R

@@ -64,7 +64,7 @@ compute_G.BQS = function(model, Tmax=50){with(model, with(Mpar,{
 #' @export
 compute_GG = function(model){with(model,{
   if(!exists("model$steady$Q")) model = steady_state(model)
-  model$KGV$GG = with(model,Mpar$G %*% diag(as.vector(steady$M$Q)))
+  model$KGV$GG = with(model,KGV$G %*% diag(as.vector(steady$M$Q)))
   return(model)
 })}
 
@@ -85,7 +85,7 @@ compute_GG = function(model){with(model,{
 #' @return invisible(NULL)
 #' @export
 plot_dispersal_G = function(model,
-                            mx_pt_sz_b = 0.7, mx_pt_sz_q = 2,
+                            mx_pt_sz_b = 0.3, mx_pt_sz_q = 2,
                             min_edge_frac = 0.01, r=.01, arw_lng=0.05, lwd=2, lamp=1,
                             seg_clr="lightblue", arw_clr="salmon"){
   with(model,with(Mpar,{
@@ -115,15 +115,14 @@ plot_dispersal_G = function(model,
 #' @return invisible(NULL)
 #' @export
 plot_dispersal_GG = function(model,
-                             mx_pt_sz_b = 0.7, mx_pt_sz_q = 2,
+                             mx_pt_sz_b = 0.3, mx_pt_sz_q = 2.5,
                              min_edge_frac = 0.01, r=.01, arw_lng=0.05, lwd=2, lamp=1,
                              seg_clr="steelblue", arw_clr="chocolate"){
   with(model,with(Mpar,{
-    par(mar=c(2,2,2,2))
     frame_bq(b, q, mtl = "Lifetime Egg Dispersal, Population")
-    add_points_b(b, max_pt_sz = mx_pt_sz_b)
     add_arrows_xx(q, KGV$GG, min_edge_frac=min_edge_frac, r=r, arw_lng=arw_lng, lwd=lwd,
                   lamp=lamp, arw_clr=arw_clr, seg_clr=seg_clr)
+    add_points_b(b, max_pt_sz = mx_pt_sz_b)
     add_points_qq(q, KGV$GG, max_pt_sz = mx_pt_sz_q)
   }))
   return(invisible())

R/graphs.R

@@ -57,7 +57,9 @@ make_common_graphs = function(model){with(model,{
 #'
 #' @returns a ramp.micro model object
 #' @export
-make_all_graphs = function(model){UseMethod("make_all_graphs",model)}
+make_all_graphs = function(model){
+  UseMethod("make_all_graphs",model$Mpar)
+}
 
 
 #' Make graphs for a BQ model

R/tiles.R

@@ -6,31 +6,35 @@
 #' @return the model, a compound [list]
 #' @export
 make_tiles = function(model){
-  UseMethod("make_tiles", model)
+  UseMethod("make_tiles", model$Mpar)
 }
 
 #' Make a set of tiles that tesselate space for the BQ model
 #'
 #'
 #' @param model a model, defined as a compound [list]
 #'
+#' @importFrom deldir deldir tile.list
+#'
 #' @return the model, a compound [list]
 #' @export
 make_tiles.BQ = function(model){with(model,{
-  model$tilesB = tile.list(deldir::deldir(b))
-  model$tilesQ = tile.list(deldir::deldir(q))
+  model$tilesB = deldir::tile.list(deldir::deldir(b))
+  model$tilesQ = deldir::tile.list(deldir::deldir(q))
   return(model)
 })}
 
 #' Make a set of tiles that tesselate space for the BQS model
 #'
 #' @param model a model, defined as a compound [list]
 #'
+#' @importFrom deldir deldir tile.list
+#'
 #' @return the model, a compound [list]
 #' @export
 make_tiles.BQS = function(model){with(model,{
-  model$tilesB = tile.list(deldir::deldir(b))
-  model$tilesQ = tile.list(deldir::deldir(q))
-  model$tilesS = tile.list(deldir::deldir(s))
+  model$tilesB = tile.list(deldir(b))
+  model$tilesQ = tile.list(deldir(q))
+  model$tilesS = tile.list(deldir(s))
   return(model)
 })}

R/utils.R

@@ -63,12 +63,12 @@ edgeSubset = function(M, min_edge_frac=0.01){
 #' 5. V; 6. VV;
 #' 7. M; 8. MM;
 #'
-#' @param i an index for the type of model
 #' @param model a model defined as a compound [list]
+#' @param i an index for the type of model
 #'
 #' @return a dispersion matrix
 #' @export
-get_matrix = function(i, model){
+get_matrix = function(model, i){
   if(i==1) M = model$KGV$Kbb
   if(i==2) M = model$KGV$Kqq
   if(i==3) M = model$KGV$G

R/vectorial_capacity.R

@@ -77,7 +77,7 @@ compute_V.BQS = function(model, Tmax=100){with(model, with(Mpar,{
 #' @export
 compute_VC = function(model){with(model,{
   if(!exists("model$steady$B")) model = steady_state(model)
-  model$VC = with(model, Mpar$V %*% diag(as.vector(steady$M$B)))
+  model$KGV$VC = with(model, KGV$V %*% diag(as.vector(steady$M$B)))
   return(model)
 })}
 
@@ -98,7 +98,7 @@ compute_VC = function(model){with(model,{
 #' @return invisible(NULL)
 #' @export
 plot_dispersal_V = function(model,
-                            max_pt_sz_b = 0.7, max_pt_sz_q = 2,
+                            max_pt_sz_b = 2, max_pt_sz_q = 0.3,
                             min_edge_frac = 0.01, r=.01, arw_lng=0.05, lwd=2, lamp=1,
                             arw_clr="darkolivegreen4", seg_clr="orangered3"){
   with(model,with(Mpar,{
@@ -128,15 +128,14 @@ plot_dispersal_V = function(model,
 #' @return invisible(NULL)
 #' @export
 plot_dispersal_VV = function(model,
-                             max_pt_sz_b = 0.7, max_pt_sz_q = 2,
+                             max_pt_sz_b = 2.5, max_pt_sz_q = 0.3,
                              min_edge_frac = 0.01, r=.01, arw_lng=0.05, lwd=2, lamp=1,
                              arw_clr="springgreen4", seg_clr="firebrick3"){
   with(model,with(Mpar,{
-    par(mar=c(2,2,2,2))
     frame_bq(b, q, mtl = "Potential Parasite Dispersal, Population")
-    add_points_q(q, max_pt_sz = max_pt_sz_q)
     add_arrows_xx(b, KGV$VC, min_edge_frac=min_edge_frac, r=r, arw_lng=arw_lng, lwd=lwd,
                   lamp=lamp, arw_clr=arw_clr, seg_clr=seg_clr)
+    add_points_q(q, max_pt_sz = max_pt_sz_q)
     add_points_bb(b, KGV$VC, max_pt_sz = max_pt_sz_b)
   }))
   return(invisible())