Updates to pass R CMD Check with new network version

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: networkLite
 Version: 1.1.0
-Date: 2024-11-23
+Date: 2025-01-08
 Title: An Simplified Implementation of the 'network' Package Functionality
 Description: An implementation of some of the core 'network' package functionality based on a 
     simplified data structure that is faster in many research applications. This package is designed 
@@ -33,9 +33,6 @@ Imports:
     dplyr
 Suggests:
     testthat
-RoxygenNote: 7.3.2.9000
+RoxygenNote: 7.3.2
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-Remotes:
-    github::statnet/statnet.common@master,
-    github::statnet/network@master  

NAMESPACE

@@ -7,6 +7,9 @@ S3method(add.edges,networkLite)
 S3method(add.vertices,networkLite)
 S3method(as.edgelist,networkLite)
 S3method(as.matrix,networkLite)
+S3method(as.matrix,networkLite.adjacency)
+S3method(as.matrix,networkLite.edgelist)
+S3method(as.matrix,networkLite.incidence)
 S3method(as.network,networkLite)
 S3method(as.networkLite,network)
 S3method(as.networkLite,networkLite)

R/add_edges.R

@@ -40,9 +40,9 @@ add.edges.networkLite <- function(x, tail, head, names.eval = NULL,
   ## if we were passed any attribute information...
   if (length(unlist(names.eval))  > 0) {
     if (!is.list(names.eval)) names.eval <-
-        as.list(rep(names.eval, length.out = length(tail)))
+      as.list(rep(names.eval, length.out = length(tail)))
     if (!is.list(vals.eval)) vals.eval <-
-        as.list(rep(vals.eval, length.out = length(names.eval)))
+      as.list(rep(vals.eval, length.out = length(names.eval)))
 
     for (i in seq_along(vals.eval)) {
       vals.eval[[i]] <- as.list(vals.eval[[i]])

R/add_vertices.R

@@ -77,20 +77,21 @@ add.vertices.networkLite <- function(x, nv, vattr = NULL,
 #' @export
 permute.vertexIDs.networkLite <- function(x, vids, ...) {
   #Sanity check: is this a permutation vector?
-  n<-network.size(x)
-  if((length(unique(vids))!=n)||any(range(vids)!=c(1,n)))
+  n <- network.size(x)
+  if ((length(unique(vids)) != n) || any(range(vids) != c(1, n)))
     stop("Invalid permutation vector in permute.vertexIDs.")
-  if(is.bipartite(x)){  #If bipartite, enforce partitioning
-    bpc<-get.network.attribute(x,"bipartite")
-    if(any(vids[0:bpc]>bpc)||any(vids[(bpc+1):n]<=bpc))
+  if (is.bipartite(x)) {  #If bipartite, enforce partitioning
+    bpc <- get.network.attribute(x, "bipartite")
+    if (any(vids[0:bpc] > bpc) || any(vids[(bpc + 1):n] <= bpc))
       warning("Performing a cross-mode permutation in permute.vertexIDs.  I hope you know what you're doing....")
   }
 
   # Remap the edge list and sort by new indices.
   o <- order(vids)
   x$el$.tail <- o[x$el$.tail]
   x$el$.head <- o[x$el$.head]
-  if(!is.directed(x)) x$el[, c(".tail", ".head")] <- cbind(pmin(x$el$.tail, x$el$.head), pmax(x$el$.tail, x$el$.head))
+  if (!is.directed(x)) x$el[, c(".tail", ".head")] <- cbind(pmin(x$el$.tail, x$el$.head),
+                                                            pmax(x$el$.tail, x$el$.head))
   x$el <- x$el[order(x$el$.tail, x$el$.head), , drop = FALSE]
 
   # Permute the vertex attributes.

R/as_networkLite.R

@@ -55,9 +55,9 @@ as.networkLite.network <- function(x, ..., atomize = TRUE) {
   }
 
   eids <- unlist(lapply(seq_len(NROW(el)),
-                 function(index) {
-                   get.edgeIDs(x, el[index, 1], el[index, 2], na.omit = FALSE)
-                 }))
+                        function(index) {
+                          get.edgeIDs(x, el[index, 1], el[index, 2], na.omit = FALSE)
+                        }))
   for (name in list.edge.attributes(x)) {
     value <- get.edge.attribute(x, name, unlist = FALSE, null.na = FALSE,
                                 na.omit = FALSE, deleted.edges.omit = FALSE)[eids]

R/attribute_methods.R

@@ -243,7 +243,7 @@ list.edge.attributes.networkLite <- function(x, ...) {
 #' @export
 delete.vertex.attribute.networkLite <- function(x, attrname, ...) {
   ## TODO: See if this can be done in one operation faster.
-  for(a in attrname) x$attr[[a]] <- NULL
+  for (a in attrname) x$attr[[a]] <- NULL
 
   modify_in_place(x)
 }
@@ -252,7 +252,7 @@ delete.vertex.attribute.networkLite <- function(x, attrname, ...) {
 #' @export
 delete.edge.attribute.networkLite <- function(x, attrname, ...) {
   ## TODO: See if this can be done in one operation faster.
-  for(a in attrname) x$el[[a]] <- NULL
+  for (a in attrname) x$el[[a]] <- NULL
 
   modify_in_place(x)
 }
@@ -261,7 +261,7 @@ delete.edge.attribute.networkLite <- function(x, attrname, ...) {
 #' @export
 delete.network.attribute.networkLite <- function(x, attrname, ...) {
   ## TODO: See if this can be done in one operation faster.
-  for(a in attrname) x$gal[[a]] <- NULL
+  for (a in attrname) x$gal[[a]] <- NULL
 
   modify_in_place(x)
 }

R/constructors.R

@@ -75,9 +75,9 @@ networkLite.edgelist <- function(
     attr = list(vertex.names = seq_len(net_attr[["n"]]),
                 na = logical(net_attr[["n"]])),
     net_attr = attributes(x)[setdiff(names(attributes(x)),
-                                         c("class", "dim", "dimnames",
-                                           "vnames", "row.names", "names",
-                                           "mnext"))],
+                                     c("class", "dim", "dimnames",
+                                       "vnames", "row.names", "names",
+                                       "mnext"))],
     ...,
     atomize = FALSE) {
 
@@ -130,7 +130,7 @@ networkLite.edgelist <- function(
   }
 
   if (!isFALSE(nw$gal[["loops"]]) || !isFALSE(nw$gal[["hyper"]]) ||
-      !isFALSE(nw$gal[["multiple"]])) {
+        !isFALSE(nw$gal[["multiple"]])) {
     stop("networkLite requires network attributes `loops`, `hyper`, and",
          " `multiple` be `FALSE`.")
   }

R/delete_vertices.R

@@ -47,36 +47,36 @@ delete.vertices.networkLite <- function(x, vid, ...) {
 #'
 #' @param x,v,alters,... see [network::get.inducedSubgraph()]
 #' @export
-get.inducedSubgraph.networkLite <- function(x, v, alters=NULL, ...){
+get.inducedSubgraph.networkLite <- function(x, v, alters = NULL, ...) {
   #Do some reality checking
-  n<-network.size(x)
+  n <- network.size(x)
 
   # do checks for v and alters
-  if((length(v)<1)||any(is.na(v))||any(v<1)||any(v>n))
+  if ((length(v) < 1) || any(is.na(v)) || any(v < 1) || any(v > n))
     stop("Illegal vertex selection in get.inducedSubgraph")
-  if(!is.null(alters)){
-    if((length(alters)<1)||any(is.na(alters))||any(alters<1)||any(alters>n)|| any(alters%in%v))
+  if (!is.null(alters)) {
+    if ((length(alters) < 1) || any(is.na(alters)) || any(alters < 1) ||
+          any(alters > n) || any(alters %in% v))
       stop("Illegal vertex selection (alters) in get.inducedSubgraph")
   }
 
   #Start by making a copy of our target network (yes, this can be wasteful)
   #TODO: in most cases, probably faster to create a new network and only copy over what is needed
 
   #Now, strip out what is needed, and/or permute in the two-mode case
-  if(is.null(alters)){                    #Simple case
-    delete.vertices(x,(1:n)[-v])           #Get rid of everyone else
-  }else{                                  #Really an edge cut, but w/vertices
-    nv<-length(v)
-    na<-length(alters)
-    newids<-sort(c(v,alters))
-    newv<-match(v,newids)
-    newalt<-match(alters,newids)
-    delete.vertices(x,(1:n)[-c(v,alters)])  #Get rid of everyone else
-    permute.vertexIDs(x,c(newv,newalt))    #Put the new vertices first
-    #Remove within-group edges
-    x$el <- x$el[(x$el$.tail <= nv) != (x$el$.head <= nv), , drop=FALSE]
-    x%n%"bipartite"<-nv   #Set bipartite attribute
+  if (is.null(alters)) {                    #Simple case
+    delete.vertices(x, (1:n)[-v])           #Get rid of everyone else
+  } else {                                  #Really an edge cut, but w/vertices
+    nv <- length(v)
+    newids <- sort(c(v, alters))
+    newv <- match(v, newids)
+    newalt <- match(alters, newids)
+    delete.vertices(x, (1:n)[-c(v, alters)])  #Get rid of everyone else
+    permute.vertexIDs(x, c(newv, newalt))    #Put the new vertices first
+    # Remove within-group edges
+    x$el <- x$el[(x$el$.tail <= nv) != (x$el$.head <= nv), , drop = FALSE]
+    x %n% "bipartite" <- nv   #Set bipartite attribute
   }
 
-  x
+  return(x)
 }

R/matrix_conversions.R

@@ -69,16 +69,17 @@ as.edgelist.networkLite <- function(x, attrname = NULL,
 
 #' @rdname matrix_conversions
 #' @export
-as_tibble.networkLite <- function(x, attrnames=(match.arg(unit)=="vertices"), na.rm=TRUE, ..., unit=c("edges", "vertices")) {
+as_tibble.networkLite <- function(x, attrnames = (match.arg(unit) == "vertices"),
+                                  na.rm = TRUE, ..., unit = c("edges", "vertices")) {
   unit <- match.arg(unit)
   df <- switch(unit, edges = x$el, vertices = x$attr)
   if (is.logical(attrnames) || is.numeric(attrnames))
     attrnames <- na.omit(setdiff(names(df), c(".tail", ".head", ".eid"))[attrnames])
 
-  # Keep only requested columns, but make sure all named columns are present.
-  if(na.rm) df <- df[!df$na,]
+  # Keep only requested columns, but make sure all named columns are present
+  if (na.rm) df <- df[!df$na, ]
   df <- df[intersect(c(".tail", ".head", ".eid", attrnames), names(df))]
-  for(a in setdiff(attrnames, names(df))) df[[a]] <- rep(list(), nrow(df))
+  for (a in setdiff(attrnames, names(df))) df[[a]] <- rep(list(), nrow(df))
 
   df <- atomize(df, ...)
   attr(df, "n") <- network.size(x)
@@ -100,6 +101,7 @@ as.matrix.networkLite <- function(x,
          edgelist = as.matrix.networkLite.edgelist(x, attrname, ...))
 }
 
+#' @export
 as.matrix.networkLite.adjacency <- function(x, attrname = NULL, ...) {
   el <- as.edgelist(x, na.rm = FALSE)
 
@@ -127,6 +129,7 @@ as.matrix.networkLite.adjacency <- function(x, attrname = NULL, ...) {
   }
 }
 
+#' @export
 as.matrix.networkLite.incidence <- function(x, attrname = NULL, ...) {
   el <- as.edgelist(x, na.rm = FALSE)
 
@@ -143,6 +146,7 @@ as.matrix.networkLite.incidence <- function(x, attrname = NULL, ...) {
   m
 }
 
+#' @export
 as.matrix.networkLite.edgelist <- function(x, attrname = NULL,
                                            na.rm = TRUE, ...) {
 

R/misc.R

@@ -97,8 +97,8 @@ is.na.networkLite <- function(x) {
 #'
 `+.networkLite` <- function(e1, e2) {
   if (!identical(e1 %n% "n", e2 %n% "n") ||
-      !identical(e1 %n% "directed", e2 %n% "directed") ||
-      !identical(e1 %n% "bipartite", e2 %n% "bipartite")) {
+        !identical(e1 %n% "directed", e2 %n% "directed") ||
+        !identical(e1 %n% "bipartite", e2 %n% "bipartite")) {
     stop("cannot add networkLites of differing network size, directedness, or",
          " bipartiteness")
   }
@@ -124,8 +124,8 @@ is.na.networkLite <- function(x) {
 #' @export
 `-.networkLite` <- function(e1, e2) {
   if (!identical(e1 %n% "n", e2 %n% "n") ||
-      !identical(e1 %n% "directed", e2 %n% "directed") ||
-      !identical(e1 %n% "bipartite", e2 %n% "bipartite")) {
+        !identical(e1 %n% "directed", e2 %n% "directed") ||
+        !identical(e1 %n% "bipartite", e2 %n% "bipartite")) {
     stop("cannot subtract networkLites of differing network size,",
          " directedness, or bipartiteness")
   }

R/networkLite-package.R

@@ -4,8 +4,8 @@
 #' \tabular{ll}{
 #'    Package: \tab networkLite\cr
 #'    Type: \tab Package\cr
-#'    Version: \tab 1.0.5\cr
-#'    Date: \tab 2023-03-10\cr
+#'    Version: \tab 1.1.0\cr
+#'    Date: \tab 2025-01-08\cr
 #'    License: \tab GPL-3\cr
 #'    LazyLoad: \tab yes\cr
 #' }

R/utils.R

@@ -47,10 +47,10 @@ atomize.tbl_df <- function(x, ..., upcast = FALSE) {
   for (name in names(x)) {
     value <- x[[name]]
     if (is.list(value) &&
-        length(value) > 0 &&
-        all(unlist(lapply(value, is.atomic))) &&
-        all(unlist(lapply(value, length)) == 1) &&
-        (upcast == TRUE || length(unique(unlist(lapply(value, class)))) == 1)) {
+          length(value) > 0 &&
+          all(unlist(lapply(value, is.atomic))) &&
+          all(unlist(lapply(value, length)) == 1) &&
+          (upcast == TRUE || length(unique(unlist(lapply(value, class)))) == 1)) {
       x[[name]] <- unlist(value)
     }
   }
@@ -66,11 +66,11 @@ ensure_list <- function(x) {
     any_list <- any(unlist(lapply(lapply(x, `[[`, name), is.list)))
     if (any_list == TRUE) {
       x <- lapply(x, function(y) {
-                       if (name %in% names(y)) {
-                         y[[name]] <- as.list(y[[name]])
-                       }
-                       y
-                     })
+        if (name %in% names(y)) {
+          y[[name]] <- as.list(y[[name]])
+        }
+        y
+      })
     }
   }
   return(x)

networkLite.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: 4584846e-a1cd-4ea7-a3fe-12c82787826e
 
 RestoreWorkspace: Default
 SaveWorkspace: Default