Merge pull request #16 from USCCANA/unnecesary-draw

Unnecesary draw
USCCANA · Jun 27, 2024 · 0ca3399 · 0ca3399
2 parents f1ff04b + d1f84b1
commit 0ca3399
Show file tree

Hide file tree

Showing 16 changed files with 71 additions and 33 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,13 +1,13 @@
 Package: netplot
 Title: Beautiful Graph Drawing
-Version: 0.2-0
+Version: 0.2-9999
 Authors@R: c(
   person("George", "Vega Yon", email = "[email protected]", role = c("aut", "cre"),
     comment = c(ORCID = "0000-0002-3171-0844")),
   person("Porter", "Bischoff", email = "[email protected]", role = c("aut"), comment = c(ORCID = "0009-0004-6742-6281"))
   )
-Description: A graph visualization engine that puts an emphasis on 
-  aesthetics at the same time of providing default parameters that yield
+Description: A graph visualization engine that emphasizes on 
+  aesthetics at the same time providing default parameters that yield
   out-of-the-box-nice visualizations. The package is built on top of
   'The Grid Graphics Package' and seamlessly work with 'igraph' and 
   'network' objects.

diff --git a/Makefile b/Makefile
@@ -1,13 +1,14 @@
 VERSION:=$(shell Rscript -e 'x<-readLines("DESCRIPTION");cat(gsub(".+[:]\\s*", "", x[grepl("^Vers", x)]))')
 PKGNAME:=$(shell Rscript -e 'x<-readLines("DESCRIPTION");cat(gsub(".+[:]\\s*", "", x[grepl("^Package", x)]))')
 
-install: 
-	$(MAKE) clean && R CMD build . && \
+install: build
+	cd ../ && \
 		R CMD INSTALL $(PKGNAME)_$(VERSION).tar.gz
 
+$(PKGNAME)_$(VERSION).tar.gz: 
+	cd ../ && R CMD build $(PKGNAME)/
 
-$(PKGNAME)_$(VERSION).tar.gz: R/*.R inst/NEWS README.md
-	R CMD build  . 
+build: $(PKGNAME)_$(VERSION).tar.gz
 
 inst/NEWS: NEWS.md
 	Rscript -e "rmarkdown::pandoc_convert('NEWS.md', 'plain', output='inst/NEWS')"&& \
@@ -29,7 +30,8 @@ checkv: $(PKGNAME)_$(VERSION).tar.gz
 	R CMD check --as-cran --use-valgrind $(PKGNAME)_$(VERSION).tar.gz
 
 clean:
-	rm -rf $(PKGNAME).Rcheck $(PKGNAME)_$(VERSION).tar.gz
+	cd ../ && \
+		rm -rf $(PKGNAME).Rcheck $(PKGNAME)_$(VERSION).tar.gz
 
 .PHONY: man docker
 man: R/* 

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,10 @@
+# netplot 0.2-9999
+
+*  Unvalid arguments passed to `nplot()` now raise an error.
+
+*  Figures with legends are not drawn twice.
+
+
 # netplot 0.2-0
 
 *  The arguments `skip.vertex`, `skip.edges`, and `skip.arrows` now work as

diff --git a/R/geometry.R b/R/geometry.R
@@ -42,7 +42,7 @@ rescale_size <- function(size, rel=c(.01, .05, 1)) {
 #' @param adj Numeric vector of length 2.
 #' @noRd
 # @export
-fit_coords_to_dev <- function(coords, adj = grDevices::dev.size()) {
+fit_coords_to_dev <- function(coords, adj = dev_size()) {
 
   # Making it -1 to 1
   yran <- range(coords[,2], na.rm = TRUE)

diff --git a/R/netplot.R b/R/netplot.R
@@ -91,7 +91,19 @@ NULL
 
 #' @export
 #' @rdname nplot
-nplot <- function(x, ..., edgelist) UseMethod("nplot")
+nplot <- function(x, ..., edgelist) {
+
+  # Checking if the passed arguments match the default class
+  res <- sapply(
+    ...names(),
+    match.arg,
+    choices = formalArgs(nplot.default),
+    several.ok = FALSE
+    )
+
+  UseMethod("nplot")
+
+}
 
 #' @export
 #' @rdname nplot
@@ -137,13 +149,13 @@ nplot.network <- function(
 ) {
 
   nplot.default(
-    x           = x,
-    layout      = layout,
-    vertex.size = vertex.size,
+    x            = x,
+    layout       = layout,
+    vertex.size  = vertex.size,
     vertex.label = vertex.label,
-    skip.arrows = skip.arrows,
+    skip.arrows  = skip.arrows,
     ...,
-    edgelist    = network::as.edgelist(x)
+    edgelist     = network::as.edgelist(x)
   )
 
 }
@@ -205,6 +217,18 @@ netplot_theme <- (function() {
 
 })()
 
+# Function to retrieve the dev.size only if there's an active device
+dev_size <- function(...) {
+
+  if (length(grDevices::dev.list())) {
+
+    grDevices::dev.size(...)
+
+  } else
+    c(7, 7)
+
+}
+
 #' @export
 #' @rdname nplot
 #' @param edgelist An edgelist.
@@ -261,12 +285,12 @@ nplot.default <- function(
   edgelist
   ) {
 
-  # We turn off the device if not need
-  if (length(grDevices::dev.list()) == 0L) {
-    on.exit(
-      grDevices::dev.off(grDevices::dev.cur())
-    )
-  }
+  # # We turn off the device if not need
+  # if (length(grDevices::dev.list()) == 0L) {
+  #   on.exit(
+  #     grDevices::dev.off(grDevices::dev.cur())
+  #   )
+  # }
 
   # listing objects
   netenv <- environment()
@@ -424,11 +448,9 @@ nplot.default <- function(
   netenv$xlim <- range(netenv$layout[,1], na.rm=TRUE)
   netenv$ylim <- range(netenv$layout[,2], na.rm=TRUE)
 
-
   # Creating layout
   # Solution from this answer https://stackoverflow.com/a/48084527
-
-  asp <- grDevices::dev.size()
+  asp <- dev_size()
 
   lo  <- grid::grid.layout(
     widths  = grid::unit(1, "null"),
@@ -593,20 +615,21 @@ nplot.default <- function(
 #' @param y,... Ignored
 print.netplot <- function(x, y = NULL, newpage = TRUE, legend = TRUE, ...) {
 
+  # If legend, then we avoid drawing twice
+  if (length(x$.legend_vertex_fill) && legend) {
+
+    color_nodes_legend(x)
+    return(invisible(x))
+
+  }
+
   # Drawing
   if (newpage) {
     grid::grid.newpage()
   }
 
   grid::grid.draw(x)
 
-  # If legend
-  if (legend) {
-
-    color_nodes_legend(x)
-
-  }
-
   # Storing the value
   .Last.netplot$set(x)
 

diff --git a/R/nplot_legend.R b/R/nplot_legend.R
@@ -69,7 +69,7 @@ nplot_legend <- function(
   gf <- grid::packGrob(grid::frameGrob(), g)
 
   # Adding the legend
-  legend.args   <- do.call(
+  legend.args <- do.call(
     grid::legendGrob,
     c(list(labels = labels, pch = pch, gp = gp), list(...))
     )

diff --git a/README.Rmd b/README.Rmd
@@ -82,6 +82,7 @@ ans <- nplot(
   UKfaculty,
   layout                = l,
   vertex.color          = ~ Group,
+  vertex.nsides         = ~ Group,
   vertex.label          = nam,
   vertex.size.range     = c(.01, .04, 4),
   vertex.label.col      =  "black",

diff --git a/README.md b/README.md
@@ -102,6 +102,7 @@ ans <- nplot(
   UKfaculty,
   layout                = l,
   vertex.color          = ~ Group,
+  vertex.nsides         = ~ Group,
   vertex.label          = nam,
   vertex.size.range     = c(.01, .04, 4),
   vertex.label.col      =  "black",

diff --git a/inst/NEWS b/inst/NEWS
@@ -1,3 +1,7 @@
+netplot 0.2-9999
+
+-   Unvalid arguments passed to nplot() now raise an error.
+
 netplot 0.2-0
 
 -   The arguments skip.vertex, skip.edges, and skip.arrows now work as

diff --git a/man/figures/README-example-1.png b/man/figures/README-example-1.png
diff --git a/man/figures/README-example-2.png b/man/figures/README-example-2.png
diff --git a/man/figures/README-example-3.png b/man/figures/README-example-3.png
diff --git a/man/figures/README-uk-faculty-gradient-1.png b/man/figures/README-uk-faculty-gradient-1.png
diff --git a/man/figures/README-unnamed-chunk-1-1.png b/man/figures/README-unnamed-chunk-1-1.png
diff --git a/man/figures/README-unnamed-chunk-1-2.png b/man/figures/README-unnamed-chunk-1-2.png
diff --git a/vignettes/examples.Rmd b/vignettes/examples.Rmd
@@ -60,7 +60,7 @@ nw <- map_base_to_grid(function() gplot(as.matrix(as_adj(UKfaculty)), coord = l_
 ```
 
 ```{r nplot, fig.keep='none'}
-nplot(UKfaculty, layout = l_ukf, main="netplot")
+nplot(UKfaculty, layout = l_ukf)
 grid::grid.text("netplot", x = .05, y=.9)
 np <- grid::grid.grab()
 ```