regular maintenance

Author: castromaa

R/annotation-gspace.R

@@ -77,15 +77,15 @@ annotation_gspace_image <- function(raster, interpolate = FALSE, opacity = 1,
   .validate_gs_args("singleLogical", "flip.v", flip.v)
   .validate_gs_args("singleLogical", "flip.h", flip.h)
   .validate_gs_args("singleNumber", "opacity", opacity)
-
+  
   if (inherits(raster, "GraphSpace")) {
-    raster <- gs_image(raster)
-    if (is.null(raster)) {
+    if (!.has_image(raster)) {
       rlang::warn("The 'GraphSpace' object contains no image.")
       return(invisible(NULL))
     }
+    raster <- gs_image(raster)
   }
-
+  
   if (!inherits(raster, "raster")) {
     raster <- tryCatch({
       grDevices::as.raster(raster)

R/geom-edgespace.R

@@ -146,12 +146,10 @@ geom_edgespace <- function(mapping = NULL, data = NULL,
   lineend = "butt", linejoin = "mitre",
   raster = FALSE, dpi = NULL, dev = "cairo", scale = 1) {
 
-  # Check custom params
-  .validate_gs_args("singleLogical", "na.rm", na.rm)
-  .validate_gs_args("singleNumber", "arrow_size", arrow_size)
-  .validate_gs_args("singleNumber", "arrow_offset", arrow_offset)
-  .validate_gs_args("singleString", "lineend", lineend)
-  .validate_gs_args("singleString", "linejoin", linejoin)
+  # Validate package-specific arguments;
+  # All other arguments are validated elsewhere.
+  .validate_gs_args("numeric_vec", "arrow_size", arrow_size)
+  .validate_gs_args("numeric_vec", "arrow_offset", arrow_offset)
 
   if (is.null(data)){
     data <- edgespace_handler()
@@ -251,7 +249,7 @@ edgespace_handler <- function() {
         rlang::warn(
           message = c(
             "x" = "`edgespace_handler()` found no edges in the input data.",
-            "i" = "Input must be a 'GraphSpace', 'gs_edges', 'igraph', 'tidygraph', or 'ggraph' layout."
+            "i" = "Input must be a 'GraphSpace', 'igraph', 'tbl_graph', or 'layout_ggraph'."
           )
         )
         data <- NULL
@@ -260,7 +258,7 @@ edgespace_handler <- function() {
       rlang::abort(
         message = c(
           "x" = "`edgespace_handler()` received an unsupported object type.",
-          "i" = "Input must be a 'GraphSpace', 'gs_edges', 'igraph', 'tidygraph', or 'ggraph' layout."
+          "i" = "Input must be a 'GraphSpace', 'igraph', 'tbl_graph', or 'layout_ggraph'."
         )
       )
     }
@@ -725,6 +723,7 @@ GeomEdgeSpace <- ggproto(
   # a tiny segment (0.01 npc) is used to anchor the arrowhead
   exy$xend <- exy$x + (edges$px * 0.01)
   exy$yend <- exy$y + (edges$py * 0.01)
+  # grid::arrow(length = ...) is vectorized; it has been tested and validate
   arrow <- grid::arrow(angle = edges$arrowAngleStart,
     type = "open", ends = "first",
     length = grid::unit(edges$arrowSize1, size_unit))
@@ -736,6 +735,7 @@ GeomEdgeSpace <- ggproto(
   # a tiny segment (0.01 npc) is used to anchor the arrowhead
   exy$x <- exy$xend - (edges$px * 0.01)
   exy$y <- exy$yend - (edges$py * 0.01)
+  # grid::arrow(length = ...) is vectorized; it has been tested and validated
   arrow <- grid::arrow(angle = edges$arrowAngleEnd,
     type = "open", ends = "last",
     length = grid::unit(edges$arrowSize2, size_unit))

R/geom-graphspace.R

@@ -182,6 +182,11 @@ geom_graphspace <- function(mapping = NULL, data,
   arrow_size = 1, arrow_offset = 0.01,
   raster = FALSE, dpi = NULL, dev = "cairo", scale = 1) {
 
+  # Validate package-specific arguments;
+  # All other arguments are validated elsewhere.
+  .validate_gs_args("numeric_vec", "arrow_size", arrow_size)
+  .validate_gs_args("numeric_vec", "arrow_offset", arrow_offset)
+  
   if (missing(data) || is.null(data)){
     rlang::warn(
       message = c(

R/geom-nodespace.R

@@ -253,7 +253,7 @@ nodespace_handler <- function(mapping = NULL) {
       rlang::abort(
         message = c(
           "x" = "`nodespace_handler()` received an unsupported object type.",
-          "i" = "Input must be a 'GraphSpace', 'gs_nodes', 'igraph', 'tidygraph', or 'ggraph' layout."
+          "i" = "Input must be a 'GraphSpace', 'igraph', 'tbl_graph', or 'layout_ggraph'."
         )
       )
     }

R/gspace-classes.R

@@ -91,6 +91,9 @@ setValidity("GraphSpace", function(object) {
   }
 
   # graph <-> nodes consistency
+  # Note: do not assume that @nodes rows and @graph vertices share the same order,
+  # as igraph accessors are independent. Downstream code relies on validated
+  # index values rather than positional order
   if (!inherits(object@graph, "igraph")) {
     errors <- c(errors, "'@graph' slot must be an igraph object.")
   } else {

R/gspace-coercion.R

@@ -36,6 +36,11 @@ as.GraphSpace.default <- function(x, ...) {
   )
 
   if (!is.null(y)) {
+    rlang::inform(paste0(
+      "No native 'as.GraphSpace' method for class '", class(x)[1], "'; ",
+      "converted via tidygraph::as_tbl_graph(). Verify the resulting graph ",
+      "structure if this wasn't the intended input."
+    ))
     return(GraphSpace(y, ...))
   }
 
@@ -137,7 +142,7 @@ as.GraphSpace.Seurat <- function(x,
     }
 
     # Remove unnamed columns occasionally returned by some methods
-    coords[, !nzchar(colnames(coords))] <- NULL
+    coords <- coords[, nzchar(colnames(coords)), drop = FALSE]
 
     if (nrow(coords) == 0L || ncol(coords) < 2L){
       rlang::abort(
@@ -170,8 +175,20 @@ as.GraphSpace.Seurat <- function(x,
   if(inherits(metadata, "data.frame") && ncol(metadata) > 0){
     cids <- setdiff(colnames(metadata), colnames(coords))
     if (length(cids) > 0){
-      metadata <- metadata[rownames(coords), cids, drop = FALSE]
-      coords <- cbind(coords, metadata)
+      if (!any(rownames(coords) %in% rownames(metadata))) {
+        rlang::warn(c(
+          "None of the coordinate row names match the Seurat object's cell identifiers.",
+          "i" = "Skipping metadata merge; the resulting GraphSpace will not include x[[]] columns."
+        ))
+      } else {
+        if (!all(rownames(coords) %in% rownames(metadata))) {
+          rlang::warn(
+            "Some coordinate row names do not match Seurat cell identifiers; corresponding metadata will be NA."
+          )
+        }
+        metadata <- metadata[rownames(coords), cids, drop = FALSE]
+        coords <- cbind(coords, metadata)
+      }
     }
   }
 
@@ -181,6 +198,11 @@ as.GraphSpace.Seurat <- function(x,
 
   # Add fdata
   fdata <- SeuratObject::LayerData(x, layer = layer)
+  if (is.null(fdata)) {
+    rlang::abort(c("x" = "LayerData() returned NULL.",
+      "i" = sprintf("Layer '%s' may not exist.", 
+        layer %||% "default")))
+  }
   fdata <- Matrix::t(fdata)
   gs_fdata(gs) <- fdata
 

R/gspace-features.R

@@ -130,25 +130,33 @@ gs_add_features <- function(x, data) {
   matched_idx <- match(node_ids, rownames(data))
   missing_count <- sum(is.na(matched_idx))
   if (missing_count == 0) {
-
+    
     # safe: matched_idx has no NAs here
     data <- data[matched_idx, , drop = FALSE]
-
+    
   } else {
-
-      rlang::warn(sprintf(
-          "%d node(s) have no feature data and will be set to NA.", 
-          missing_count))
 
-      result <- Matrix::Matrix(
-          NA_real_,
-          nrow = length(node_ids),
-          ncol = ncol(data),
-          dimnames = list(node_ids, colnames(data))
-      )
-      present <- !is.na(matched_idx)
-      result[present, ] <- data[matched_idx[present], , drop = FALSE]
-      data <- result
+    rlang::warn(sprintf(
+      "%d node(s) have no feature data and will be set to NA.", 
+      missing_count))
+    
+    # 'result' is always dense (Matrix::Matrix(NA_real_, ...)); 'data' may
+    # be sparse (e.g. dgCMatrix) at this point. Assigning a sparse-derived
+    # row subset into a dense row-subset target, as below, has been
+    # verified empirically: correct values (including stored structural
+    # zeros, not coerced to NA) for both partial node coverage (this
+    # branch) and shuffled/reordered row names matched via 'matched_idx'.
+    # Not a risk needing further guarding -- Matrix's S4 dispatch handles
+    # this correctly.
+    result <- Matrix::Matrix(
+      NA_real_,
+      nrow = length(node_ids),
+      ncol = ncol(data),
+      dimnames = list(node_ids, colnames(data))
+    )
+    present <- !is.na(matched_idx)
+    result[present, ] <- data[matched_idx[present], , drop = FALSE]
+    data <- result
   }
 
   # Load fdata slot

R/gspace-generics.R

@@ -1,12 +1,15 @@
 
-setGeneric("GraphSpace", function(g, ...) standardGeneric("GraphSpace"))
+setGeneric("GraphSpace", function(g, ...) 
+  standardGeneric("GraphSpace"),
+  package = "RGraphSpace"
+)
 
 setGeneric("plotGraphSpace", function(gs, ...)
   standardGeneric("plotGraphSpace"),
   package = "RGraphSpace"
 )
 
-setGeneric("getGraphSpace", function(gs, what = "summary") 
+setGeneric("getGraphSpace", function(gs, ...) 
   standardGeneric("getGraphSpace"), 
   package = "RGraphSpace"
 )

R/gspace-ggplot-constructor.R

@@ -184,6 +184,8 @@ ggplot_add.inject_nodespace <- function(object, plot, ...) {
     return(plot)
   }
 
+  # Note: @data/@layers/@scales require ggplot2 >= 4.0 (S7 plot objects).
+  # This requirement is intentional and enforced in DESCRIPTION.
   for(i in seq_along(plot@layers)){
 
     layer <- plot@layers[[i]]

R/gspace-methods.R

@@ -166,19 +166,20 @@ setMethod("GraphSpace", signature(g = "ANY"),
         error = function(e) NULL
       )
       g <- attr(g, "graph")
+    } else if (inherits(g, "tbl_graph")) {
+      g <- tidygraph::as.igraph(g)
     }
 
-    if (inherits(g, "igraph")) {
-      class(g) <- "igraph"
-    } else {
+    if (!inherits(g, "igraph")) {
       rlang::abort(
         message = c(
           "x" = "Input 'g' must inherit from the 'igraph' class.",
-          "i" = paste("Received an object of class:", paste(class(g), collapse = "/")),
-          "*" = "Did you mean to use `tidygraph::as_tbl_graph()`?"
+          "i" = "Input must be an 'igraph', 'tbl_graph', or 'layout_ggraph'."
         )
       )
     }
+    class(g) <- "igraph"
+    
     if(!is.null(layout)){
       .validate_gs_args("numeric_mtx", "layout", layout)
       if (ncol(layout) != 2) {
@@ -232,6 +233,9 @@ setMethod("GraphSpace", signature(g = "data.frame"),
 
   # Initialize a graph using 'coord' as vertices, with no edges
   g <- make_empty_graph(n = nrow(coord), directed = FALSE)
+  
+  # If 'coord' has no row names (a common case for a plain data.frame), 
+  # sequential names will be later assigned in the validation functions
   if(!is.null(rownames(coord))){
     V(g)$name <- rownames(coord)
   }
@@ -266,12 +270,12 @@ setMethod("GraphSpace", signature(g = "data.frame"),
 #' @param xlab The title for the 'x' axis of a 2D-image space.
 #' @param ylab The title for the 'y' axis of a 2D-image space.
 #' @param font.size A single numeric value passed to ggplot themes.
-#' @param bg.color A single color for background.
+#' @param bg.colour A single color for background.
 #' @param add.labels A logical value indicating whether to plot vertex labels.
 #' @param node.labels A vector of vertex names to be highlighted in the graph
 #' space. This argument overrides 'add.labels'.
 #' @param label.size A size argument passed to \code{\link[ggplot2]{geom_text}}.
-#' @param label.color A color passed to \code{\link[ggplot2]{geom_text}}.
+#' @param label.colour A color passed to \code{\link[ggplot2]{geom_text}}.
 #' @param add.image A logical value indicating whether to add a background 
 #' image, when one is available (see \code{\link{GraphSpace}}).
 #' @param raster A logical value indicating whether to rasterize the main plot.
@@ -319,9 +323,9 @@ setMethod("GraphSpace", signature(g = "data.frame"),
 setMethod("plotGraphSpace", "GraphSpace", 
   function(gs, theme = "th0", xlab = "Graph coordinates 1", 
     ylab = "Graph coordinates 2", font.size = 1,
-    bg.color = "grey95", add.labels = FALSE,
+    bg.colour = "grey95", add.labels = FALSE,
     node.labels = NULL, label.size = 3, 
-    label.color = "grey20", add.image = TRUE, 
+    label.colour = "grey20", add.image = TRUE, 
     raster = FALSE, dpi = 300, dev = "cairo_png") {
 
     gs <- updateGraphSpace(gs)
@@ -330,10 +334,10 @@ setMethod("plotGraphSpace", "GraphSpace",
     .validate_gs_args("singleString", "xlab", xlab)
     .validate_gs_args("singleString", "ylab", ylab)
     .validate_gs_args("singleNumber", "font.size", font.size)
-    .validate_gs_colors("singleColor", "bg.color", bg.color)
+    .validate_gs_colors("singleColor", "bg.colour", bg.colour)
     .validate_gs_args("singleLogical", "add.labels", add.labels)
     .validate_gs_args("singleNumber", "label.size", label.size)
-    .validate_gs_colors("singleColor", "label.color", label.color)
+    .validate_gs_colors("singleColor", "label.colour", label.colour)
     .validate_gs_args("singleLogical", "add.image", add.image)
     .validate_gs_args("singleLogical", "raster", raster)
     .validate_gs_args("singleInteger", "dpi", dpi)
@@ -362,7 +366,7 @@ setMethod("plotGraphSpace", "GraphSpace",
         ggi <- ggi + theme_gspace_coords(theme = theme, 
           is_norm = pars$is.normalized, xlab = xlab, ylab = ylab, 
           txt_size = font.size, leg_size = font.size, 
-          bg_color = bg.color)
+          bg_colour = bg.colour)
       }
     }
 
@@ -372,7 +376,7 @@ setMethod("plotGraphSpace", "GraphSpace",
     #--- add node labels
     if (!is.null(node.labels)){
       ggp <- .add_labels1(ggp, nodes, node.labels, 
-        label.size, label.color)
+        label.size, label.colour)
     } else if(add.labels){
       ggp <- .add_labels2(ggp, nodes)
     }
@@ -381,7 +385,7 @@ setMethod("plotGraphSpace", "GraphSpace",
     ggp <- ggp + theme_gspace_coords(theme = theme, 
       is_norm = pars$is.normalized, xlab = xlab, ylab = ylab, 
       txt_size = font.size, leg_size = font.size,
-      bg_color = bg.color)
+      bg_colour = bg.colour)
 
     if(raster){
       ggp <- ggrastr::rasterize(ggp, layers = "GraphSpace", 
@@ -440,7 +444,7 @@ plot.GraphSpace <- function(x, ...) {
 #-------------------------------------------------------------------------------
 #' @title Accessors for fetching slots from a GraphSpace object
 #'
-#' @description \code{getGraphSpace} retrives information from
+#' @description \code{getGraphSpace} retrieves information from
 #' individual slots available in a GraphSpace object.
 #'
 #' @param gs A preprocessed \linkS4class{GraphSpace} class object
@@ -458,7 +462,7 @@ plot.GraphSpace <- function(x, ...) {
 #' # Create a new GraphSpace object
 #' gs <- GraphSpace(gtoy1)
 #'
-#' # Get the 'summary' slot in gs
+#' # Get the 'graph' slot in gs
 #' getGraphSpace(gs, what = 'graph')
 #'
 #' @import methods
@@ -835,8 +839,7 @@ setMethod("gs_edge_attr<-", "GraphSpace", function(x, name, ..., value) {
   x@graph <- .validate_igraph(g)
   nodes   <- .get_nodes(x@graph)
   if (x@pars$is.normalized) {
-    nodes$x <- x@nodes$x
-    nodes$y <- x@nodes$y
+    nodes[x@nodes$name, c("x","y")] <- x@nodes[, c("x","y")]
   }
   x@nodes <- nodes
   return(x)