From 83fc6c1db1e2bd2c6a0e817fc1db00101545716c Mon Sep 17 00:00:00 2001 From: Porter Bischoff Date: Wed, 30 Aug 2023 15:41:28 -0600 Subject: [PATCH] updating grob.vertex --- R/grob_vertex.R | 70 +++++++++++++++++++++++-------------------------- 1 file changed, 33 insertions(+), 37 deletions(-) diff --git a/R/grob_vertex.R b/R/grob_vertex.R index c5255c1..e4aff18 100644 --- a/R/grob_vertex.R +++ b/R/grob_vertex.R @@ -6,6 +6,33 @@ #' Generating coordinates #' @noRd grob_vertex <- function(netenv, v) { + + # Add formula handling + if(is.formula(netenv$vertex.nsides)) { + var_name <- all.vars(netenv$vertex.nsides)[1] + netenv$vertex.nsides <- eval(netenv$vertex.nsides, envir = data) + } + + # Relax vertex.nsides validation + if(!is.numeric(netenv$vertex.nsides[v]) & !is.character(netenv$vertex.nsides[v])) { + stop("vertex.nsides must be numeric or character") + } + + # Handle shape names + if(is.character(netenv$vertex.nsides[v])) { + + shape <- netenv$vertex.nsides[v] + + if(shape %in% names(sides_lookup)) { + info <- sides_lookup[[shape]] + netenv$vertex.nsides[v] <- info$sides + netenv$vertex.rot[v] <- info$rot + } else { + stop("Invalid shape name: ", shape) + } + + } + validate_netenv(netenv) validate_params(v) sides_lookup <- c( @@ -18,22 +45,7 @@ grob_vertex <- function(netenv, v) { octagon = list(sides = 8, rot = 0), circle = list(sides = 25, rot = 0) ) - # if(is.na(netenv$vertex.label[v])) { - # stop("Missing vertex label value") - # } - # if(!netenv$vertex.label[v] %in% names(sides_lookup)) { - # stop("Invalid vertex shape name: ", netenv$vertex.label[v]) - # } - # if(is.na(netenv$layout[v, 1]) || is.na(netenv$layout[v, 2])) { - # stop("Missing vertex coordinates") - # } - # if(netenv$layout[v, 1] < 0 || netenv$layout[v, 2] < 0) { - # warning("Negative coordinate values") - # } - # if(!is.character(col)) { - # stop("Invalid color value") - # } if (netenv$skip.vertex) return( grid::gTree( @@ -46,27 +58,6 @@ grob_vertex <- function(netenv, v) { ) ) - # Only if it is character - if (is.numeric(netenv$vertex.nsides[v])) { - - if(netenv$vertex.nsides[v] < 2) { # Only if numeric... - stop("Number of sides must be 2 or greater") - } - - } else if (is.character(netenv$vertex.nsides[v]) { - - if(netenv$vertex.nsides[v] %in% names(sides_lookup)) { - info <- sides_lookup[[netenv$vertex.nsides[v]]] - netenv$vertex.nsides[v] <- info$sides - netenv$vertex.rot[v] <- info$rot - } else { - stop("Invalid vertex shape name: ", netenv$vertex.nsides[v]) - } - - } - - # If it is numeric, check the number of sides (as you do above) - # Computing coordinates coords <- npolygon( x = netenv$layout[v, 1], @@ -75,6 +66,7 @@ grob_vertex <- function(netenv, v) { r = netenv$vertex.size[v]*(1 - netenv$vertex.frame.prop[v]), d = netenv$vertex.rot[v] ) + # Frame coordinates framecoords <- npolygon( x = netenv$layout[v, 1], @@ -83,13 +75,16 @@ grob_vertex <- function(netenv, v) { r = netenv$vertex.size[v], d = netenv$vertex.rot[v] ) + # Create color palette nsides <- unique(netenv$vertex.nsides) ncolors <- length(nsides) colors <- hsv(h = seq(0, 1, length.out = ncolors), v = 1, a = 1) pal <- setNames(colors, nsides) + # Lookup color for this vertex based on number of sides col <- pal[as.character(netenv$vertex.nsides[v])] + # Returning ans <- grid::polygonGrob( x = c(coords[,1]), @@ -101,6 +96,7 @@ grob_vertex <- function(netenv, v) { default.units = "native", name = "core" ) + ans <- grid::grobTree( grid::polygonGrob( x = framecoords[,1], @@ -115,7 +111,7 @@ grob_vertex <- function(netenv, v) { ans, name = netplot_name$make(v) ) - # If the users is drawing text +# If the users is drawing text if (length(netenv$vertex.label) && !is.na(netenv$vertex.label[v])) { # Only if it is big enough if (netenv$label_threshold <= netenv$vertex.size[v])