Merge pull request #19 from dd-harp/dev

minor bug fixes, mostly minor changes

Author: smitdave

NAMESPACE

@@ -76,8 +76,8 @@ export(edgeSubset)
 export(edgeSubset_fracMass)
 export(frame_bq)
 export(frame_bqs)
+export(get_graph)
 export(get_matrix)
-export(get_net)
 export(init_adult_model)
 export(init_adult_model_BQ)
 export(init_adult_model_BQS)
@@ -105,8 +105,6 @@ export(make_model_squareLattice)
 export(make_model_unif)
 export(make_movie)
 export(make_tiles)
-export(mod_convex_hulls)
-export(mod_convex_hulls.i)
 export(net2patches)
 export(outline_points_b)
 export(outline_points_q)
@@ -137,6 +135,7 @@ export(plot_dispersal_VV)
 export(plot_graph)
 export(plot_matrix_xx)
 export(plot_matrix_xy)
+export(plot_meta)
 export(plot_patches)
 export(plot_points)
 export(plot_points_bq)

R/compute_EGG.R renamed to R/compute_G.R

@@ -1,5 +1,8 @@
 
-#' Compute the dispersion of eggs after one feeding cycle
+#' Compute egg dispersion
+#' @description
+#' Compute the dispersion of eggs away from natal habitats.
+#'
 #'
 #' @param model a compound [list] defining a model
 #' @param Tmax the last time step
@@ -10,7 +13,7 @@ compute_G = function(model, Tmax){
   UseMethod("compute_G", model$Mpar)
 }
 
-#' Compute the dispersion of eggs after one feeding cycle for the BQ model
+#' Compute egg dispersion, BQ model
 #'
 #' @param model a compound [list] defining a model
 #' @param Tmax the last time step
@@ -32,7 +35,7 @@ compute_G.BQ = function(model, Tmax=50){with(model, with(Mpar,{
   return(model)
 }))}
 
-#' Compute the dispersion of eggs after one feeding cycle for the BQ model
+#' Compute egg dispersion, BQS model
 #'
 #' @param model a compound [list] defining a model
 #' @param Tmax the last time step

R/compute_K_matrices.R renamed to R/compute_K.R

@@ -1,39 +1,63 @@
 # Visualize communities as convex hulls
 
+#' Stretch (or shrink) the convex hull for plotting
+#'
+#' @param xy a convex hull
+#' @param fac a factor to stretch (>1) or shrink (<1) the hull for plotting
+#'
+#' @return a new point set
+#' @export
+stretch_convex_hull = function(xy, fac){
+  cx = mean(xy[,1])
+  cy = mean(xy[,2])
+  xn = xy[,1] - cx
+  yn = xy[,2] - cy
+
+  r = sqrt(xn^2 + yn^2)
+  theta = atan2(yn,xn)
+  sxy =  cbind(
+    r*fac*cos(theta) + cx,
+    r*fac*sin(theta) + cy
+  )
+  return(sxy)
+}
+
+# Visualize communities as convex hulls
+
 #' Make a set of convex hulls to visualize the community
 #'
 #' @param model a model defined as a compound [list]
-#' @param net a network object
+#' @param graph a graphwork object
 #' @param cut if !null, the number of communities for igraph::cut_at
 #' @param clrs a set of colors
 #' @param f_color a function that returns a list of colors (e.g. viridis::turbo)
 #'
-#' @return the network object with convex hulls attached
+#' @return the graphwork object with convex hulls attached
 #' @export
-make_convex_hulls = function(model, net, cut=NULL, clrs=NULL, f_color = viridis::turbo){
-  clusters = net$walktrap_clusters
+make_convex_hulls = function(model, graph, cut=NULL, clrs=NULL, f_color = viridis::turbo){
+  clusters = graph$walktrap_clusters
   memix = if(is.null(cut)){
     igraph::membership(clusters)
   } else {
     igraph::cut_at(clusters, cut)
   }
-  if(net$type == "b"){
+  if(graph$type == "b"){
     xy = model$b
   }
-  if(net$type == "q"){
+  if(graph$type == "q"){
     xy = model$q
   }
-  if(net$type == "bq"){
+  if(graph$type == "bq"){
     xy = with(model,rbind(b, q))
   }
-  net$convex_hulls = list()
+  graph$convex_hulls = list()
   if(is.null(clrs)) clrs = f_color(max(memix))
   for(i in 1:max(memix)){
-    net$convex_hulls[[i]] = list()
-    net$convex_hulls[[i]]$xy = make_convex_hull_i(i, memix, xy)
-    net$convex_hulls[[i]]$clr = clrs[i]
+    graph$convex_hulls[[i]] = list()
+    graph$convex_hulls[[i]]$xy = make_convex_hull_i(i, memix, xy)
+    graph$convex_hulls[[i]]$clr = clrs[i]
   }
-  return(net)
+  return(graph)
 }
 
 #' Make the convex hull for the i^th community
@@ -47,17 +71,12 @@ make_convex_hulls = function(model, net, cut=NULL, clrs=NULL, f_color = viridis:
 #' @return a [list] with a hull
 #' @export
 make_convex_hull_i = function(i, memix, xy){
-  ixj = which(memix == i)
-  hpts <- grDevices::chull(xy[ixj,])
-  ixk = c(hpts, hpts[1])
-  hxy = xy[ixj[ixk],]
-  return(hxy)
+  ix = which(memix == i)
+  return(make_convex_hull(xy[ix,]))
 }
 
 #' Make the convex hull for the i^th community
 #'
-#' @param i the i^th community
-#' @param memix the community membership indices
 #' @param xy the point set
 #'
 #' @return the xy points that define a convex hull
@@ -74,16 +93,16 @@ make_convex_hull_xy = function(xy){
 
 #' Add the convex hulls to a framed plot
 #'
-#' @param net a network object
+#' @param graph a graphwork object
 #' @param stretch make the hull slightly larger or slightly smaller
 #' @param lwd hull line width
 #'
 #' @return invisible(NULL)
 #' @export
-plot_convex_hulls = function(net, stretch=1.1, lwd=2){
-  n = length(net$convex_hulls)
+plot_convex_hulls = function(graph, stretch=1.1, lwd=2){
+  n = length(graph$convex_hulls)
   for(i in 1:n){
-    with(net$convex_hulls[[i]],{
+    with(graph$convex_hulls[[i]],{
       sxy = stretch_convex_hull(xy, stretch)
       graphics::polygon(sxy[,1], sxy[,2], border=clr, lwd=lwd)
     })
@@ -111,72 +130,3 @@ add_convex_hulls = function(memix, xy, clrs, stretch=0.1, lwd=2, llty=1){
   return(invisible())
 }
 
-
-#' Stretch (or shrink) the convex hull for plotting
-#'
-#' @param xy a convex hull
-#' @param fac a factor to stretch (>1) or shrink (<1) the hull for plotting
-#'
-#' @return a new point set
-#' @export
-stretch_convex_hull = function(xy, fac){
-  cx = mean(xy[,1])
-  cy = mean(xy[,2])
-  xn = xy[,1] - cx
-  yn = xy[,2] - cy
-
-  r = sqrt(xn^2 + yn^2)
-  theta = atan2(yn,xn)
-  sxy =  cbind(
-    r*fac*cos(theta) + cx,
-    r*fac*sin(theta) + cy
-  )
-  return(sxy)
-}
-
-
-#' Make a set of convex hulls to visualize the community
-#'
-#' @param model a model defined as a compound [list]
-#' @param net a network object
-#' @param cut if !null, the number of communities for igraph::cut_at
-#' @param f_color a function that returns a list of colors (e.g. viridis::turbo)
-#'
-#' @return the network object with convex hulls attached
-#' @export
-mod_convex_hulls.i = function(model, i, cut=NULL, f_color=turbo, stretch=0.1, lwd=2){
-  net = getNet.i(model, i)
-  mod_convex_hulls.i(model, net, cut, clr_scheme, stretch, lwd)
-}
-
-#' Make a set of convex hulls to visualize the community
-#'
-#' @param model a model defined as a compound [list]
-#' @param net a network object
-#' @param cut if !null, the number of communities for igraph::cut_at
-#' @param clrs a list of colors
-#' @param f_color a function that returns a list of colors (e.g. viridis::turbo)
-#' @param stretch a stretch factor for the hulls
-#' @param lwd the line width for plotting
-#'
-#' @return the network object with convex hulls attached
-#' @export
-mod_convex_hulls = function(model, net, cut=NULL, clrs=NULL, f_color=viridis::turbo, stretch=0.1, lwd=2){
-  clusters = net$walktrap_clusters
-  memix = if(is.null(cut)){
-    membership(clusters)
-  } else {
-    cut_at(clusters, cut)
-  }
-  if(net$type == "b"){
-    xy = model$b
-  }
-  if(net$type == "q"){
-    xy = model$q
-  }
-  if(net$type == "bq"){
-    xy = with(model,rbind(b, q))
-  }
-  if(is.null(clrs)) clrs = f_color(max(memix))
-  add_convex_hulls(memix, xy, clrs, stretch, lwd)
-}

R/compute_VC.R renamed to R/compute_V.R

@@ -1,5 +1,31 @@
 # temporarily moved to RAMP-modelel-Library
 
+#' Choose one of the networks describing dispersion
+#' @description
+#' 1 -Kbb; 2 - Kqq;
+#' 3 - G; 4 - GG;
+#' 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]
+#'
+#' @return a net object
+#' @export
+get_graph = function(model, i){
+  if(i==1) graph = model$graphs$Kbb_graph
+  if(i==2) graph = model$graphs$Kqq_graph
+  if(i==3) graph = model$graphs$G_graph
+  if(i==4) graph = model$graphs$GG_graph
+  if(i==5) graph = model$graphs$V_graph
+  if(i==6) graph = model$graphs$VC_graph
+  if(i==7) graph = model$graphs$M_graph
+  if(i==8) graph = model$graphs$MM_graph
+  return(graph)
+}
+
+
 #' Make graph object
 #'
 #' @description
@@ -102,7 +128,7 @@ make_all_graphs.BQS = function(model){
 #' Plot the ouptuts of a graph using
 #'
 #' @param model a `ramp.micro` model object
-#' @param graphs a graphswork object
+#' @param graph a graph object
 #' @param cut optional arguent for cut_at
 #' @param alg walktrap = "wt" or greedy = "gr"
 #' @param f_color a function that returns a list of colors (e.g. viridis::turbo)
@@ -214,7 +240,7 @@ plot_subgraph = function(model, graph, cut=NULL, alg="wt",
 #' Plot the ouptuts of a graph using
 #'
 #' @param model a `ramp.micro` model object
-#' @param graphs a graphswork object
+#' @param graph a graph object
 #' @param cut optional arguent for cut_at
 #' @param alg walktrap = "wt" or greedy = "gr"
 #' @param f_color a function that returns a list of colors (e.g. viridis::turbo)

R/network_convex_hulls.R renamed to R/convex_hulls.R

@@ -2,13 +2,13 @@
 #' Use communities to define patches
 #'
 #' @param model a ramp.micro model object
-#' @param i which graph (see get_net)
+#' @param i which graph (see get_graph)
 #' @param cut cutat argument, # communities (optional)
 #' @importFrom igraph membership cut_at
 #' @returns a ramp.micro model object
 #' @export
 net2patches =function(model, i, cut=NULL){
-  net = get_net(model, i)
+  net = get_graph(model, i)
   clusters = net$walktrap_clusters
   if(net$type == "b") xy = model$b
   if(net$type == "q") xy = model$q
@@ -65,7 +65,7 @@ net2patches =function(model, i, cut=NULL){
 #' @returns a ramp.micro model object
 #' @export
 plot_patches = function(model, i, cut=NULL, f_color = viridis::turbo, stretch=0.1, lwd=2, bbend=3, mtl = NULL){
-  net = get_net(model, i)
+  net = get_graph(model, i)
   model = net2patches(model, i, cut)
   if(net$type == "b") patches <- model$b_patches
   if(net$type == "q") patches <- model$q_patches
@@ -87,7 +87,7 @@ plot_patches = function(model, i, cut=NULL, f_color = viridis::turbo, stretch=0.
 #' Plot the ouptuts of a graph using
 #'
 #' @param model a `ramp.micro` model object
-#' @param graphs a graphswork object
+#' @param graph a graphswork object
 #' @param cut optional arguent for cut_at
 #' @param alg walktrap = "wt" or greedy = "gr"
 #' @param f_color a function that returns a list of colors (e.g. viridis::turbo)

R/network_graphs.R renamed to R/graphs.R

@@ -79,14 +79,14 @@ plot_Kbb = function(model,  cx_b=2, cx_q=0.3,
                     clr_b ="#cc444bCC", clr_q ="#4361eeCC"
 ){
   with(model,with(Mpar,
-       {
-         frame_bq(b, q)
-         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, cx_s=cx_q))
-         add_points_q(q, cx_q=cx_q, clr_q=clr_q)
-         add_points_bb(b, KGV$Kbb, cx_b=cx_b, clr_bA=arw_clr, clr_bB=clr_b)
-       }))
+                  {
+                    frame_bq(b, q)
+                    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, cx_s=cx_q))
+                    add_points_q(q, cx_q=cx_q, clr_q=clr_q)
+                    add_points_bb(b, KGV$Kbb, cx_b=cx_b, clr_bA=arw_clr, clr_bB=clr_b)
+                  }))
   return(invisible())
 }
 

R/setup_Psi_matrices.R renamed to R/make_Psi.R

@@ -79,28 +79,3 @@ get_matrix = function(model, i){
   if(i==8) M = model$Mpar$bigMM
   return(M)
 }
-
-#' Choose one of the networks describing dispersion
-#' @description
-#' 1. Kbb; 2. Kqq;
-#' 3. G; 4. GG;
-#' 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]
-#'
-#' @return a net object
-#' @export
-get_net = function(model, i){
-  if(i==1) net = model$graphs$Kbb_net
-  if(i==2) net = model$graphs$Kqq_net
-  if(i==3) net = model$graphs$G_net
-  if(i==4) net = model$graphs$GG_net
-  if(i==5) net = model$graphs$V_net
-  if(i==6) net = model$graphs$VC_net
-  if(i==7) net = model$graphs$M_net
-  if(i==8) net = model$graphs$MM_net
-  return(net)
-}