New options and working on sunble

USCCANA · Apr 4, 2018 · c1032ac · c1032ac
1 parent b975dfe
commit c1032ac
Show file tree

Hide file tree

Showing 20 changed files with 146 additions and 61 deletions.
diff --git a/ChangeLog b/ChangeLog
@@ -1,3 +1,8 @@
+2018-04-04  George G. Vega Yon <[email protected]>
+	* src/plot.cpp: Separating edge from arrow.
+	* R/diffnet-methods.r: Idem
+
+
 2018-04-02  George G. Vega Yon <[email protected]>
 	* R/plot_diffnet2.r: Fixing bug in diffMap on plot_diffnet2.
 	* R/rdiffnet.r: Loading netdiffuseR when using ncpus.

diff --git a/R/diffnet-methods.r b/R/diffnet-methods.r
@@ -607,12 +607,14 @@ plot_diffnet.default <- function(
 #' rotation in radians of each vertex (see details).
 #' @param edge.width Numeric. Width of the edges.
 #' @param edge.color Character. Color of the edges.
+#' @param arrow.width Numeric value to be passed to \code{\link{arrows}}.
 #' @param arrow.length Numeric value to be passed to \code{\link{arrows}}.
 #' @param include.grid Logical. When TRUE, the grid of the graph is drawn.
 #' @param bty See \code{\link{par}}.
 #' @param xlim Passed to \code{\link{plot}}.
 #' @param ylim Passed to \code{\link{plot}}.
 #' @param ... Additional arguments passed to \code{\link{plot}}.
+#' @param curved Logical scalar. When curved, generates curved edges.
 #' @family visualizations
 #' @seealso Use \code{\link{threshold}} to retrieve the corresponding threshold
 #' obtained returned by \code{\link{exposure}}.
@@ -703,6 +705,7 @@ plot_threshold.default <- function(
   vertex.rot       = 0,
   edge.width       = 2,
   edge.color       = NULL,
+  arrow.width      = nslices(graph)/80,
   arrow.length     = nslices(graph)/80,
   include.grid     = TRUE,
   vertex.frame.color = NULL,
@@ -711,6 +714,7 @@ plot_threshold.default <- function(
   jitter.amount    = c(.25,0),
   xlim             = NULL,
   ylim             = NULL,
+  curved           = TRUE,
   ...
   ) {
 
@@ -802,14 +806,39 @@ plot_threshold.default <- function(
   ran  <- c(xlim[2]-xlim[1], ylim[2]-ylim[1])
 
   # Plotting the edges
-  mapply(function(x0, y0, x1, y1, col) {
-    y <- edges_arrow(x0, y0, x1, y1, width=arrow.length, height=arrow.length,
+  mapply(function(x0, y0, x1, y1, col, curved) {
+    y <- edges_arrow(x0, y0, x1, y1, width=arrow.width, height=arrow.length,
                      beta=pi*(2/3), dev=par("pin"), ran=ran)
 
-    graphics::polygon(y[,1], y[,2], col = col, border = col)
+    # Drawing arrow
+    if (curved) {
+      # Modifying edge
+      r <- runif(1, .20, .80)
+      y$edge <- rbind(
+        y$edge[1,],
+        y$edge[1,]*c(r, 1-r) + y$edge[2,]*c(1-r, r),
+        y$edge[2,]
+      )
+
+      # Edge
+      graphics::xspline(
+        y$edge[,1],y$edge[,2],
+        shape = c(0, 1, 0),
+        open=TRUE, border = col, lwd=edge.width)
+
+      # Arrow
+      graphics::polygon(y$arrow[,1], y$arrow[,2], col = col, border = col)
+    } else {
+      # Edge
+      graphics::polygon(y$edge[,1],y$edge[,2], col = col, border = col, lwd=edge.width)
+
+      # Arrow
+      graphics::polygon(y$arrow[,1], y$arrow[,2], col = col, border = col)
+    }
+
 
   }, x0 = edges[,"x0"], y0 = edges[,"y0"], x1 = edges[,"x1"], y1 = edges[,"y1"],
-  col = edge.color)
+  col = edge.color, curved = curved)
 
   # Drawing the vertices and its labels
   # Computing the coordinates

diff --git a/README.md b/README.md
@@ -165,7 +165,7 @@ summary(diffnet)
 out <- plot_infectsuscep(diffnet, bins = 20,K=5, logscale = FALSE, h=.01)
 ```
 
-![](README_files/figure-markdown_github-ascii_identifiers/plot_infectsuscept-1.png)
+![](README_files/figure-markdown_github/plot_infectsuscept-1.png)
 
 ``` r
 out <- plot_infectsuscep(diffnet, bins = 20,K=5, logscale = TRUE,
@@ -176,7 +176,7 @@ out <- plot_infectsuscep(diffnet, bins = 20,K=5, logscale = TRUE,
     ## Warning in plot_infectsuscep.list(graph$graph, graph$toa, t0, normalize, :
     ## When applying logscale some observations are missing.
 
-![](README_files/figure-markdown_github-ascii_identifiers/plot_infectsuscept-2.png)
+![](README_files/figure-markdown_github/plot_infectsuscept-2.png)
 
 ### Threshold
 
@@ -205,7 +205,7 @@ diffnet
 plot_threshold(diffnet, vertex.size = .4)
 ```
 
-![](README_files/figure-markdown_github-ascii_identifiers/BoringThreshold,%20plot_threshold-1.png)
+![](README_files/figure-markdown_github/BoringThreshold,%20plot_threshold-1.png)
 
 Using more features
 
@@ -224,41 +224,38 @@ plot_threshold(
     ## Warning in (function (graph, expo, toa, include_censored = FALSE, t0 =
     ## min(toa, : -vertex.sides- will be coerced to integer.
 
-![](README_files/figure-markdown_github-ascii_identifiers/NiceThreshold-1.png)
+![](README_files/figure-markdown_github/NiceThreshold-1.png)
 
 ### Adoption rate
 
 ``` r
 plot_adopters(diffnet)
 ```
 
-![](README_files/figure-markdown_github-ascii_identifiers/Adopters-1.png)
+![](README_files/figure-markdown_github/Adopters-1.png)
 
 ### Hazard rate
 
 ``` r
 hazard_rate(diffnet)
 ```
 
-![](README_files/figure-markdown_github-ascii_identifiers/Hazard-1.png)
+![](README_files/figure-markdown_github/Hazard-1.png)
 
 ### Diffusion process
 
 ``` r
 plot_diffnet(medInnovationsDiffNet, slices=c(1,9,8))
 ```
 
-![](README_files/figure-markdown_github-ascii_identifiers/plot_diffnet-1.png)
+![](README_files/figure-markdown_github/plot_diffnet-1.png)
 
 ``` r
 diffnet.toa(brfarmersDiffNet)[brfarmersDiffNet$toa >= 1965] <- NA
 plot_diffnet2(brfarmersDiffNet, vertex.size = "indegree")
 ```
 
-    ## Warning in as_generic_graph.igraph(graph): The -igraph- object has multiple
-    ## edges. Only one of each will be retrieved.
-
-![](README_files/figure-markdown_github-ascii_identifiers/plot_diffnet2-1.png)
+![](README_files/figure-markdown_github/plot_diffnet2-1.png)
 
 ``` r
 set.seed(1231)
@@ -288,7 +285,7 @@ mtext("Both networks have the same distribution on times of adoption", 1,
       outer = TRUE)
 ```
 
-![](README_files/figure-markdown_github-ascii_identifiers/plot_diffnet2%20with%20map-1.png)
+![](README_files/figure-markdown_github/plot_diffnet2%20with%20map-1.png)
 
 ``` r
 par(oldpar)
@@ -321,7 +318,7 @@ legend("bottom", legend = levels(out$thr), fill=blues9[2:6], horiz = TRUE,
        cex=.6, bty="n", inset=c(0,-.1))
 ```
 
-![](README_files/figure-markdown_github-ascii_identifiers/mosaic-1.png)
+![](README_files/figure-markdown_github/mosaic-1.png)
 
 ``` r
 par(oldpar)
@@ -333,7 +330,7 @@ par(oldpar)
 sessionInfo()
 ```
 
-    ## R version 3.4.2 (2017-09-28)
+    ## R version 3.4.4 (2018-03-15)
     ## Platform: x86_64-pc-linux-gnu (64-bit)
     ## Running under: Ubuntu 14.04.5 LTS
     ## 
@@ -353,17 +350,17 @@ sessionInfo()
     ## [1] stats     graphics  grDevices utils     datasets  methods   base     
     ## 
     ## other attached packages:
-    ## [1] netdiffuseR_1.19.0
+    ## [1] netdiffuseR_1.19.999
     ## 
     ## loaded via a namespace (and not attached):
-    ##  [1] igraph_1.1.2         Rcpp_0.12.13         knitr_1.17          
+    ##  [1] igraph_1.2.1         Rcpp_0.12.16         knitr_1.20          
     ##  [4] magrittr_1.5         network_1.13.0       networkDynamic_0.9.0
-    ##  [7] MASS_7.3-47          lattice_0.20-35      stringr_1.2.0       
-    ## [10] tools_3.4.2          MatchIt_3.0.1        grid_3.4.2          
-    ## [13] sna_2.4              htmltools_0.3.6      yaml_2.1.14         
-    ## [16] rprojroot_1.2        digest_0.6.12        Matrix_1.2-11       
-    ## [19] evaluate_0.10.1      rmarkdown_1.6        statnet.common_4.0.0
-    ## [22] stringi_1.1.5        compiler_3.4.2       backports_1.1.1     
+    ##  [7] MASS_7.3-49          lattice_0.20-35      stringr_1.3.0       
+    ## [10] tools_3.4.4          MatchIt_3.0.2        grid_3.4.4          
+    ## [13] sna_2.4              htmltools_0.3.6      yaml_2.1.18         
+    ## [16] rprojroot_1.3-2      digest_0.6.15        Matrix_1.2-11       
+    ## [19] evaluate_0.10.1      rmarkdown_1.9        statnet.common_4.0.0
+    ## [22] stringi_1.1.7        compiler_3.4.4       backports_1.1.2     
     ## [25] boot_1.3-20          SparseM_1.77         pkgconfig_2.0.1
 
 To-do list

diff --git a/man/plot_threshold.Rd b/man/plot_threshold.Rd
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -217,7 +217,7 @@ BEGIN_RCPP
 END_RCPP
 }
 // edges_arrow
-arma::mat edges_arrow(const double& x0, const double& y0, const double& x1, const double& y1, const double& height, const double& width, const double beta, NumericVector dev, NumericVector ran);
+List edges_arrow(const double& x0, const double& y0, const double& x1, const double& y1, const double& height, const double& width, const double beta, NumericVector dev, NumericVector ran);
 RcppExport SEXP _netdiffuseR_edges_arrow(SEXP x0SEXP, SEXP y0SEXP, SEXP x1SEXP, SEXP y1SEXP, SEXP heightSEXP, SEXP widthSEXP, SEXP betaSEXP, SEXP devSEXP, SEXP ranSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;

diff --git a/src/plot.cpp b/src/plot.cpp
@@ -321,7 +321,7 @@ a <- atan((-3.4510269 - -0.8881612)/(0.8045981-0.3114116))
 
 
 // [[Rcpp::export]]
-arma::mat edges_arrow(
+List edges_arrow(
     const double & x0,
     const double & y0,
     const double & x1,
@@ -333,7 +333,7 @@ arma::mat edges_arrow(
     NumericVector ran = NumericVector::create()
 ) {
   // Creating output
-  arma::mat coords(6,2);
+  arma::mat coords(4,2);
 
   // If yexpand is too small, just throw an error ------------------------------
   if (ran.length() == 0) {
@@ -367,19 +367,29 @@ arma::mat edges_arrow(
   coords.at(2,0) = x1 - cos(alpha)*height;
   coords.at(2,1) = y1 - sin(alpha)*height*yexpand;
 
-  // Bottom
-  coords.at(3,0) = x0;
-  coords.at(3,1) = y0;
-
-  // Back to the center
-  coords.at(4,0) = coords.at(2,0);
-  coords.at(4,1) = coords.at(2,1);
+  // // Bottom
+  // coords.at(3,0) = x0;
+  // coords.at(3,1) = y0;
+  //
+  // // Back to the center
+  // coords.at(4,0) = coords.at(2,0);
+  // coords.at(4,1) = coords.at(2,1);
 
   // Right
-  coords.at(5,0) = x1 - cos(alpha)*height + cos(-beta+alpha)*width;
-  coords.at(5,1) = y1 - (sin(alpha)*height - sin(-beta+alpha)*width)*yexpand;
-
-  return coords;
+  coords.at(3,0) = x1 - cos(alpha)*height + cos(-beta+alpha)*width;
+  coords.at(3,1) = y1 - (sin(alpha)*height - sin(-beta+alpha)*width)*yexpand;
+
+  // Actual line coords
+  arma::mat coords_edge(2u, 2u);
+  coords_edge.at(0,0) = x0;
+  coords_edge.at(0,1) = y0;
+  coords_edge.at(1,0) = coords.at(2,0);
+  coords_edge.at(1,1) = coords.at(2,1);
+
+  return List::create(
+    _["arrow"] = coords,
+    _["edge"]  = coords_edge
+  );
 }
 
 /** *R

diff --git a/tutorials/sunbelt2018/_site/problem2.rda b/tutorials/sunbelt2018/_site/problem2.rda
diff --git a/tutorials/sunbelt2018/_site/sim.html b/tutorials/sunbelt2018/_site/sim.html
diff --git a/tutorials/sunbelt2018/_site/sim_files/figure-html/sim-sim-results-1.png b/tutorials/sunbelt2018/_site/sim_files/figure-html/sim-sim-results-1.png
diff --git a/tutorials/sunbelt2018/_site/stats.html b/tutorials/sunbelt2018/_site/stats.html
diff --git a/tutorials/sunbelt2018/_site/stats_files/figure-html/geodesic_speed-box-1.png b/tutorials/sunbelt2018/_site/stats_files/figure-html/geodesic_speed-box-1.png
diff --git a/tutorials/sunbelt2018/_site/stats_files/figure-html/unnamed-chunk-2-1.png b/tutorials/sunbelt2018/_site/stats_files/figure-html/unnamed-chunk-2-1.png
diff --git a/tutorials/sunbelt2018/_site/stats_files/figure-html/unnamed-chunk-3-1.png b/tutorials/sunbelt2018/_site/stats_files/figure-html/unnamed-chunk-3-1.png
diff --git a/tutorials/sunbelt2018/intro.rmd b/tutorials/sunbelt2018/intro.rmd
@@ -130,17 +130,17 @@ diffnet <- rdiffnet(
 diffnet[["ItrustMyFriends"]] <- dat$ItrustMyFriends
 diffnet[["Age"]] <- dat$Age
 
-# What they should see
-plot_threshold(
-  diffnet,
-  vertex.col = adjustcolor(dat$ItrustMyFriends+1, .7),
-  edge.col = adjustcolor("gray", .3))
-legend(
-  "bottomright",
-  legend = c(0, 1),
-  fill = c(1, 2),
-  title = "ItrustMyFriends"
-)
+# # What they should see
+# plot_threshold(
+#   diffnet,
+#   vertex.col = adjustcolor(dat$ItrustMyFriends+1, .7),
+#   edge.col = adjustcolor("gray", .3))
+# legend(
+#   "bottomright",
+#   legend = c(0, 1),
+#   fill = c(1, 2),
+#   title = "ItrustMyFriends"
+# )
 save(diffnet, file = "problems_intro.rda")
 ```
 
diff --git a/tutorials/sunbelt2018/problem2.rda b/tutorials/sunbelt2018/problem2.rda
diff --git a/tutorials/sunbelt2018/sim_files/figure-html/sim-sim-results-1.png b/tutorials/sunbelt2018/sim_files/figure-html/sim-sim-results-1.png
diff --git a/tutorials/sunbelt2018/stats.rmd b/tutorials/sunbelt2018/stats.rmd
@@ -190,6 +190,14 @@ hist(test)
                subset = is.na(toa) | (per <= toa))
     summary(ans)
     ```
+    
+    Alternatively, we could have used the new function `diffreg`
+    
+    ```{r}
+    ans <- diffreg(dn ~ exposure + var1 + factor(per), type = "probit")
+    summary(ans)
+    ```
+    
 
 ## Contemporaneous exposure models
 

diff --git a/tutorials/sunbelt2018/stats_files/figure-html/geodesic_speed-box-1.png b/tutorials/sunbelt2018/stats_files/figure-html/geodesic_speed-box-1.png
diff --git a/tutorials/sunbelt2018/stats_files/figure-html/unnamed-chunk-2-1.png b/tutorials/sunbelt2018/stats_files/figure-html/unnamed-chunk-2-1.png
diff --git a/tutorials/sunbelt2018/stats_files/figure-html/unnamed-chunk-3-1.png b/tutorials/sunbelt2018/stats_files/figure-html/unnamed-chunk-3-1.png