diff --git a/.gitignore b/.gitignore index 4dbc536..234f028 100644 --- a/.gitignore +++ b/.gitignore @@ -2,5 +2,4 @@ .Rhistory .RData .Ruserdata -.rda docs diff --git a/NAMESPACE b/NAMESPACE index 09d8647..debdfb8 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/Psi_matrices.R b/R/Psi_matrices.R index 2ea9eaf..e96ecc2 100644 --- a/R/Psi_matrices.R +++ b/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()) } diff --git a/R/adult-BQS.R b/R/adult-BQS.R index 65ebe8c..d64a72b 100644 --- a/R/adult-BQS.R +++ b/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) diff --git a/R/graphs.R b/R/graphs.R index 85372ea..8d3cd99 100644 --- a/R/graphs.R +++ b/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 diff --git a/R/kernels.R b/R/kernels.R index 56b747e..fd84d7a 100644 --- a/R/kernels.R +++ b/R/kernels.R @@ -1,5 +1,18 @@ -#' 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{d1}, the decay is +slower for \eqn{d - %\VignetteIndexEntry{Community Analysis} + %\VignetteIndexEntry{Communities} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- diff --git a/vignettes/community.html b/vignettes/community.html index 5702e07..8f9b7b2 100644 --- a/vignettes/community.html +++ b/vignettes/community.html @@ -12,7 +12,7 @@ -Community Analysis +Communities