Merge pull request #12 from dd-harp/dev

Moving towards version 0.9

Author: smitdave

.gitignore

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

NAMESPACE

@@ -20,6 +20,8 @@ S3method(make_Kbq,BQ)
 S3method(make_Kbq,BQS)
 S3method(make_Kqb,BQ)
 S3method(make_Kqb,BQS)
+S3method(make_all_graphs,BQ)
+S3method(make_all_graphs,BQS)
 S3method(make_movie,BQ)
 S3method(make_movie,BQS)
 S3method(make_tiles,BQ)
@@ -67,8 +69,8 @@ export(edgeSubset)
 export(edgeSubset_fracMass)
 export(frame_bq)
 export(frame_bqs)
-export(getM_i)
-export(getNet_i)
+export(get_matrix)
+export(get_net)
 export(init_adult_model)
 export(init_adult_model_BQ)
 export(init_adult_model_BQS)
@@ -86,17 +88,21 @@ export(make_Psi_BQ)
 export(make_Psi_BQS)
 export(make_Psi_xx)
 export(make_Psi_xy)
+export(make_all_graphs)
+export(make_all_graphs_common)
 export(make_convex_hull_i)
 export(make_convex_hulls)
 export(make_demography_BQ)
 export(make_demography_BQS)
+export(make_graph_obj)
 export(make_kF_exp)
 export(make_kF_mix)
 export(make_kF_pwr)
 export(make_model_squareLattice)
 export(make_model_unif)
 export(make_movie)
 export(make_tiles)
+export(net2meta)
 export(plotDDcmf)
 export(plotDDpmf)
 export(plot_Kbb)
@@ -122,6 +128,7 @@ export(plot_dispersal_V)
 export(plot_dispersal_VV)
 export(plot_matrix_xx)
 export(plot_matrix_xy)
+export(plot_meta)
 export(plot_points)
 export(plot_points_bq)
 export(plot_points_bqs)
@@ -138,3 +145,9 @@ export(setup_model)
 export(steady_state)
 export(stretch_convex_hull)
 export(unif_xy)
+importFrom(igraph,E)
+importFrom(igraph,cluster_fast_greedy)
+importFrom(igraph,cluster_walktrap)
+importFrom(igraph,cut_at)
+importFrom(igraph,graph_from_adjacency_matrix)
+importFrom(igraph,membership)

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$Mpar$Kbb = with(model$Mpar, Kqb %*% Kbq)
+  model$KGV$Kbb = with(model$KGV, Kqb %*% Kbq)
   return(model)
 }
 
@@ -39,7 +39,7 @@ make_Kbb = function(model){
 #' @return the model, a compound [list]
 #' @export
 make_Kqq = function(model){
-  model$Mpar$Kqq = with(model$Mpar, Kbq %*% Kqb)
+  model$KGV$Kqq = with(model$KGV, Kbq %*% Kqb)
   return(model)
 }
 
@@ -59,7 +59,7 @@ make_Kbq.BQ = function(model, Tmax=100){with(model, with(Mpar,{
     Kbq = Kbq + diag(pB*psiB, nb) %*% Psi_bb %*% Bt
     Bt = diag(pB*(1-psiB), nb) %*% Psi_bb %*% Bt
   }
-  model$Mpar$Kbq = Kbq
+  model$KGV$Kbq = Kbq
   return(model)
 }))}
 
@@ -79,7 +79,7 @@ make_Kqb.BQ = function(model, Tmax=100){with(model, with(Mpar,{
     Kqb = Kqb + diag(pQ*psiQ, nq) %*% Psi_qq %*% Qt
     Qt =diag(pQ*(1-psiQ), nq) %*% Psi_qq %*%Qt
   }
-  model$Mpar$Kqb = Kqb
+  model$KGV$Kqb = Kqb
   return(model)
 }))}
 
@@ -122,7 +122,7 @@ make_Kqb.BQS = function(model, Tmax=200){with(model,with(Mpar,{
   for(i in 1:Tmax) Kt = M%*%Kt
   Kt[-c(1:(nb+nq+ns)),]
 
-  model$Mpar$Kqb = Kt[nb+nq+ns+c(1:nb),]
+  model$KGV$Kqb = Kt[nb+nq+ns+c(1:nb),]
   return(model)
 }))}
 
@@ -163,7 +163,7 @@ make_Kbq.BQS = function(model, Tmax = 200){with(model,with(Mpar,{
   Kt = rbind(0*Mbb, Cno, 0*Mbs, Cyes)
   for(i in 1:Tmax) Kt = M%*%Kt
   Kt[-c(1:(nb+nq+ns)),]
-  model$Mpar$Kbq = Kt[nb+nq+ns+c(1:nq),]
+  model$KGV$Kbq = Kt[nb+nq+ns+c(1:nq),]
   return(model)
 }))}
 
@@ -187,12 +187,12 @@ plot_Kqb = function(model, max_pt_sz=2,
                     min_edge_frac=0.01, r=0.02, arw_lng=0.002, lwd=2,
                     clr_K="#4361eeCC", clr_b='red', clr_q ='darkblue'){
   with(model,with(Mpar,{
-    frame_bq(b, q, mtl = expression(K[q%<-%b]))
+    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, Kqb, min_edge_frac=min_edge_frac,
+    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)
-    add_points_qq(q, Kqb, max_pt_sz=max_pt_sz, colA=clr_q)
+    add_points_qq(q, KGV$Kqb, max_pt_sz=max_pt_sz, colA=clr_q)
   }))
   return(invisible())
 }
@@ -215,13 +215,13 @@ plot_Kbq = function(model, max_pt_sz=2,
                     min_edge_frac=0.01, r=0.02, arw_lng=0.002, lwd=2,
                     clr_K="#fe5f55CC", clr_b='darkred', clr_q="#858ae399"){
   with(model,with(Mpar,{
-    frame_bq(b, q, mtl = expression(K[b%<-%q]))
+    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, Kbq, min_edge_frac=min_edge_frac,
+    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)
-    add_points_bb(b, Kbq, max_pt_sz=max_pt_sz, colB=clr_b)
+    add_points_bb(b, KGV$Kbq, max_pt_sz=max_pt_sz, colB=clr_b)
   }))
   return(invisible())
 }
@@ -247,12 +247,12 @@ plot_Kbb = function(model, max_pt_sz=2,
 ){
   with(model,with(Mpar,
        {
-         frame_bq(b, q, mtl = expression(K[b %<-%b]))
-         add_arrows_xx(b, Psi_bb, min_edge_frac=min_edge_frac,
+         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)
-         add_points_bb(b, Kbb, max_pt_sz=max_pt_sz, colA=arw_clr, colB=clr_b)
+         add_points_bb(b, KGV$Kbb, max_pt_sz=max_pt_sz, colA=arw_clr, colB=clr_b)
        }))
   return(invisible())
 }
@@ -277,12 +277,12 @@ plot_Kqq = function(model, max_pt_sz=2,
                     arw_clr = "#abc4ff55", seg_clr ='#00000022',
                     clr_q="#858ae399", clr_b="#cc444bCC"){
   with(model,with(Mpar,{
-    frame_bq(b, q, mtl = expression(K[q %<-%q]))
+    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, Psi_qq, min_edge_frac=min_edge_frac,
+    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)
-    add_points_qq(q, Kqq, max_pt_sz=max_pt_sz, colA=arw_clr, colB=clr_q)
+    add_points_qq(q, KGV$Kqq, max_pt_sz=max_pt_sz, colA=arw_clr, colB=clr_q)
   }))
   return(invisible())
 }

R/adult-BQ.R

@@ -40,10 +40,10 @@ save_states_M.BQ = function(t, model){
 #'
 #' @return a [numeric] value, the sum of squared differences
 #' @export
-compute_diffs_M.BQ = function(Mvars1, Mvars2){
-  dfs = sum((Mvars1$B - Mvars2$B)^2) + sum((Mvars1$Q - Mvars2$Q)^2)
+compute_diffs_M.BQ = function(model){with(model,{
+  dfs = sum((Mvars$B - steady$M$B)^2) + sum((Mvars$Q - steady$M$Q)^2)
   return (dfs)
-}
+})}
 
 #' Save the state variables in a vector
 #'

R/adult-BQS.R

@@ -43,12 +43,12 @@ save_states_M.BQS = function(t, model){
 #'
 #' @return a [numeric] value, the sum of squared differences
 #' @export
-compute_diffs_M.BQS = function(Mvars1, Mvars2){
-  dfs = sum((Mvars1$B - Mvars2$B)^2)
-  dfs = dfs + sum((Mvars1$Q - Mvars2$Q)^2)
-  dfs = dfs + sum((Mvars1$S - Mvars2$S)^2)
+compute_diffs_M.BQS = function(model){with(model,{
+  dfs = sum((Mvars$B - steady$M$B)^2)
+  dfs = dfs + sum((Mvars$Q - steady$M$Q)^2)
+  dfs = dfs + sum((Mvars$S - steady$M$S)^2)
   return (dfs)
-}
+})}
 
 #' Save the state variables in a vector
 #'

R/adult-interface.R

@@ -44,13 +44,12 @@ init_adult_model = function(model, M0_opts){
 
 #' The some of squared differences between two sets of variables
 #'
-#' @param Mvars1 variables describing adult mosquitoes, set 1
-#' @param Mvars2 variables describing adult mosquitoes, set 2
+#' @param model a model
 #'
 #' @return a [numeric] value, the sum of squared differences
 #' @export
-compute_diffs_M = function(Mvars1, Mvars2){
-  UseMethod("compute_diffs_M", Mvars1)
+compute_diffs_M = function(model){
+  UseMethod("compute_diffs_M", model$Mpar)
 }
 
 #' Setup an adult model

R/aquatic-basicL.R

@@ -58,10 +58,10 @@ save_states_L.basicL = function(t, model){
 #'
 #' @return a [numeric] value, the sum of squared differences
 #' @export
-compute_diffs_L.basicL = function(Lvars1, Lvars2){
-  dfs = sum((Lvars1$L - Lvars2$L)^2)
+compute_diffs_L.basicL = function(model){with(model,{
+  dfs = sum((Lvars$L - steady$L$L)^2)
   return (dfs)
-}
+})}
 
 #' Save the state variables in a vector
 #'

R/aquatic-interface.R

@@ -34,13 +34,12 @@ save_states_L=function(t, model){
 
 #' The some of squared differences between two sets of variables
 #'
-#' @param Lvars1 variables describing adult mosquitoes, set 1
-#' @param Lvars2 variables describing adult mosquitoes, set 2
+#' @param model a model
 #'
 #' @return a [numeric] value, the sum of squared differences
 #' @export
-compute_diffs_L = function(Lvars1, Lvars2){
-  UseMethod("compute_diffs_L", Lvars1)
+compute_diffs_L = function(model){
+  UseMethod("compute_diffs_L", model$Lpar)
 }
 
 #' Initialize the Lstates

R/dispersal_distances.R

@@ -1,7 +1,7 @@
 
 #' Compute distances dispersed
 #'
-#' @param xy a set of point locations
+#' @param xy locations of a set of points
 #' @param M a dispersal matrix
 #'
 #' @return a [list] with the PMF, CMF, mean distance dispersed, and the distance matrix

R/egg_laying.R

@@ -28,7 +28,7 @@ compute_G.BQ = function(model, Tmax=50){with(model, with(Mpar,{
     G = G + eggs
     B = Bt; Q=Qt
   }
-  model$G = G
+  model$KGV$G = G
   return(model)
 }))}
 
@@ -52,7 +52,7 @@ compute_G.BQS = function(model, Tmax=50){with(model, with(Mpar,{
     G = G + eggs
     B = Bt; Q=Qt; S=St
   }
-  model$Mpar$G = G
+  model$KGV$G = G
   return(model)
 }))}
 
@@ -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$GG = with(model,Mpar$G %*% diag(as.vector(steady$Q)))
+  model$KGV$GG = with(model,Mpar$G %*% diag(as.vector(steady$M$Q)))
   return(model)
 })}
 
@@ -92,9 +92,9 @@ plot_dispersal_G = function(model,
     par(mar=c(2,2,2,2))
     frame_bq(b, q, mtl = "Lifetime Egg Dispersal, per Mosquito")
     add_points_b(b, max_pt_sz = mx_pt_sz_b)
-    add_arrows_xx(q, G, min_edge_frac=min_edge_frac, r=r, arw_lng=arw_lng, lwd=lwd,
+    add_arrows_xx(q, KGV$G, 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_qq(q, G, max_pt_sz = mx_pt_sz_q)
+    add_points_qq(q, KGV$G, max_pt_sz = mx_pt_sz_q)
   }))
   return(invisible())
 }
@@ -122,9 +122,9 @@ plot_dispersal_GG = function(model,
     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, GG, min_edge_frac=min_edge_frac, r=r, arw_lng=arw_lng, lwd=lwd,
+    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_qq(q, GG, max_pt_sz = mx_pt_sz_q)
+    add_points_qq(q, KGV$GG, max_pt_sz = mx_pt_sz_q)
   }))
   return(invisible())
 }