Merge pull request #79 from stocnet/develop

v1.0.4

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: manynet
 Title: Many Ways to Make, Modify, Map, Mark, and Measure Myriad Networks
-Version: 1.0.3
-Date: 2024-07-23
+Version: 1.0.4
+Date: 2024-07-25
 Description: Many tools for making, modifying, mapping, marking, measuring, 
    and motifs and memberships of many different types of networks.
    All functions operate with matrices, edge lists, and 'igraph', 'network', and 'tidygraph' objects,

NEWS.md

@@ -1,3 +1,25 @@
+# manynet 1.0.4
+
+## Modifying
+
+- `as_matrix.igraph()` now only draws from the "weight" attribute and not, e.g. "type"
+- Fixed bug in `to_blocks()` related to categorical membership variables
+
+## Marks
+
+- Tie marks now infer networks when used within e.g. `mutate_ties()`
+
+## Memberships
+
+- `node_names()` now returns names of the form "N01" etc for unlabelled networks
+- Fixed how `plot.matrix()` works for unlabelled networks
+- Added more on density in community tutorial
+
+## Mapping
+
+- British spelling arguments now appear further back in e.g. `graphr()`
+- Fixed how `graphs()` recognises ego networks so it is compatible with other splits
+
 # manynet 1.0.3
 
 ## Mapping

R/class_members.R

@@ -99,11 +99,25 @@ plot.matrix <- function(x, ..., membership = NULL) {
   } else {
     blocked_data <- manynet::as_matrix(x)
   }
-
-  plot_data <- as.data.frame(blocked_data) %>%
-    dplyr::mutate(Var1 = rownames(blocked_data)) %>%
-    tidyr::pivot_longer(!.data[["Var1"]], names_to = "Var2", values_to = "value")
-  g <- ggplot2::ggplot(plot_data, ggplot2::aes(.data[["Var2"]], .data[["Var1"]])) +
+
+  from <- to <- weight <- NULL
+
+  plot_data <- as_edgelist(blocked_data)
+  if(!is_labelled(x)){
+    indices <- c(plot_data$from,plot_data$to)
+    plot_data$from <- paste0("N", gsub("\\s", "0", 
+                                       format(plot_data$from, 
+                                              width=max(nchar(indices)))))
+    plot_data$to <- paste0("N", gsub("\\s", "0", 
+                                     format(plot_data$to, 
+                                            width=max(nchar(indices)))))
+  }
+  all_nodes <- expand.grid(node_names(blocked_data), 
+                            node_names(blocked_data))
+  all_nodes <- data.frame(from = all_nodes$Var1, to = all_nodes$Var2,
+                          weight = 0)
+  plot_data <- rbind(plot_data, all_nodes) %>% dplyr::distinct(from, to, .keep_all = TRUE)
+  g <- ggplot2::ggplot(plot_data, ggplot2::aes(to, from)) +
     ggplot2::theme_grey(base_size = 9) +
     ggplot2::labs(x = "", y = "") +
     ggplot2::theme(
@@ -119,12 +133,13 @@ plot.matrix <- function(x, ..., membership = NULL) {
         colour = "grey50"
       )
     ) +
-    ggplot2::geom_tile(ggplot2::aes(fill = .data[["value"]]),
+    # ggplot2::geom_tile(ggplot2::aes(fill = .data[["value"]]),
+    ggplot2::geom_tile(ggplot2::aes(fill = weight),
                        colour = "white"
     )
 
   # Color for signed networks
-  if (manynet::is_signed(x)) {
+  if (is_signed(x)) {
     g <- g +
       ggplot2::scale_fill_gradient2(high = "#003049",
         mid = "white",
@@ -138,7 +153,7 @@ plot.matrix <- function(x, ..., membership = NULL) {
   }
 
   # Structure for multimodal networks
-  if (!manynet::is_twomode(x)) {
+  if (!is_twomode(x)) {
     g <- g +
       ggplot2::scale_x_discrete(expand = c(0, 0), position = "top",
                                 limits = colnames(blocked_data)
@@ -147,6 +162,7 @@ plot.matrix <- function(x, ..., membership = NULL) {
                                 limits = rev(rownames(blocked_data))
       )
     if (!is.null(membership))
+      if(!is.numeric(membership)) membership <- as.numeric(as.factor(membership))
       g <- g + ggplot2::geom_vline(
         xintercept = c(1 + which(diff(membership[order(membership)]) != 0))
         - .5,

R/manip_as.R

@@ -203,15 +203,15 @@ as_matrix.igraph <- function(.data,
   if ((!is.null(twomode) && twomode) | (is.null(twomode) & is_twomode(.data))) {
     if (is_weighted(.data) | is_signed(.data)) {
       mat <- igraph::as_biadjacency_matrix(.data, sparse = FALSE,
-                                           attr = igraph::edge_attr_names(.data)[[1]])
+                                           attr = ifelse(is_weighted(.data), "weight", NULL))
     } else {
       mat <- igraph::as_biadjacency_matrix(.data, sparse = FALSE,
                                            attr = NULL)
     }
   } else {
     if (is_weighted(.data) | is_signed(.data)) {
       mat <- igraph::as_adjacency_matrix(.data, sparse = FALSE,
-                                         attr = igraph::edge_attr_names(.data)[[1]])
+                                         attr = ifelse(is_weighted(.data), "weight", NULL))
     } else {
       mat <- igraph::as_adjacency_matrix(.data, sparse = FALSE,
                                          attr = NULL)

R/manip_reformed.R

@@ -368,6 +368,7 @@ to_blocks.matrix <- function(.data, membership, FUN = mean){
     y <- length(unique(m2_membs))
     out <- matrix(nrow = unique(m1_membs)[x],
                   ncol = unique(m2_membs)[y])
+    membership <- as.numeric(as.factor(membership))
     for(i in unique(m1_membs)) for (j in unique(m2_membs))
       out[i, j] <- FUN(mat[membership == i, 
                            membership == j, drop = FALSE], 
@@ -376,6 +377,7 @@ to_blocks.matrix <- function(.data, membership, FUN = mean){
     colnames(out) <- paste("Block", seq_len(unique(m2_membs)[y]))
   } else {
     mat <- .data
+    membership <- as.numeric(as.factor(membership))
     parts <- max(membership)
     out <- matrix(nrow = parts, 
                   ncol = parts)

R/map_autograph.R

@@ -104,8 +104,9 @@
 #' #           edge_size = tie_closeness(ison_karateka))
 #' @export
 graphr <- function(.data, layout, labels = TRUE,
-                   node_color, node_colour, node_shape, node_size, node_group,
-                   edge_color, edge_colour, edge_size, ...) {
+                   node_color, node_shape, node_size, node_group,
+                   edge_color, edge_size, ...,
+                   node_colour, edge_colour) {
   g <- as_tidygraph(.data)
   if (missing(layout)) {
     if (length(g) == 3 | length(g) == 4) {
@@ -722,8 +723,7 @@ graphs <- function(netlist, waves,
     gs <- lapply(1:length(netlist), function(i)
       graphr(netlist[[i]], x = x, y = y, ...) + ggtitle(names(netlist)[i]))
   } else {
-    if (!methods::hasArg("layout") & all(order_alphabetically(names(netlist)) ==
-            order_alphabetically(unique(unlist(unname(lapply(netlist, node_names))))))) {
+    if (!methods::hasArg("layout") & is_ego_network(netlist)) {
       gs <- lapply(1:length(netlist), function(i)
         graphr(netlist[[i]], layout = "star", center = names(netlist)[[i]], ...) + 
           ggtitle(names(netlist)[i]))
@@ -739,6 +739,14 @@ graphs <- function(netlist, waves,
   do.call(patchwork::wrap_plots, c(gs, list(guides = "collect")))
 }
 
+is_ego_network <- function(nlist) {
+  if (all(unique(names(nlist)) != "")) {
+    length(names(nlist)) == length(unique(unlist(unname(lapply(nlist, node_names))))) &
+    all(order_alphabetically(names(nlist)) ==
+          order_alphabetically(unique(unlist(unname(lapply(nlist, node_names))))))
+  } else FALSE
+}
+
 order_alphabetically <- function(v) {
   v[order(names(stats::setNames(v, v)))]
 }
@@ -797,8 +805,9 @@ order_alphabetically <- function(v) {
 #' @export
 grapht <- function(tlist, keep_isolates = TRUE,
                    layout, labels = TRUE,
-                   node_color, node_colour, node_shape, node_size,
-                   edge_color, edge_colour, edge_size, ...) {
+                   node_color, node_shape, node_size,
+                   edge_color, edge_size, ...,
+                   node_colour, edge_colour) {
   thisRequires("gganimate")
   thisRequires("gifski")
   thisRequires("png")

R/mark_ties.R

@@ -25,6 +25,7 @@ NULL
 #' tie_is_multiple(ison_marvel_relationships)
 #' @export
 tie_is_multiple <- function(.data){
+  if(missing(.data)) {expect_edges(); .data <- .G()}
   make_tie_mark(igraph::which_multiple(manynet::as_igraph(.data)), .data)
 }
 
@@ -34,6 +35,7 @@ tie_is_multiple <- function(.data){
 #' tie_is_loop(ison_marvel_relationships)
 #' @export
 tie_is_loop <- function(.data){
+  if(missing(.data)) {expect_edges(); .data <- .G()}
   make_tie_mark(igraph::which_loop(manynet::as_igraph(.data)), .data)
 }
 
@@ -43,6 +45,7 @@ tie_is_loop <- function(.data){
 #' tie_is_reciprocated(ison_algebra)
 #' @export
 tie_is_reciprocated <- function(.data){
+  if(missing(.data)) {expect_edges(); .data <- .G()}
   make_tie_mark(igraph::which_mutual(manynet::as_igraph(.data)), .data)
 }
 
@@ -52,6 +55,7 @@ tie_is_reciprocated <- function(.data){
 #' tie_is_feedback(ison_algebra)
 #' @export
 tie_is_feedback <- function(.data){
+  if(missing(.data)) {expect_edges(); .data <- .G()}
   .data <- manynet::as_igraph(.data)
   make_tie_mark(igraph::E(.data) %in% igraph::feedback_arc_set(.data), 
                 .data)
@@ -63,6 +67,7 @@ tie_is_feedback <- function(.data){
 #' tie_is_bridge(ison_brandes)
 #' @export
 tie_is_bridge <- function(.data){
+  if(missing(.data)) {expect_edges(); .data <- .G()}
   num_comp <- length( igraph::decompose(manynet::as_igraph(.data)) )
   out <- vapply(seq_len(manynet::net_ties(.data)), function(x){
     length( igraph::decompose(igraph::delete_edges(.data, x)) ) > num_comp
@@ -92,6 +97,7 @@ NULL
 #' @rdname mark_tie_select
 #' @export
 tie_is_random <- function(.data, size = 1){
+  if(missing(.data)) {expect_edges(); .data <- .G()}
   n <- manynet::net_ties(.data)
   out <- rep(FALSE, n)
   out[sample.int(n, size)] <- TRUE

R/measure_attributes.R

@@ -33,7 +33,12 @@ node_attribute <- function(.data, attribute){
 #' node_names(ison_southern_women)
 #' @export
 node_names <- function(.data){
-  igraph::vertex_attr(as_igraph(.data), "name")
+  if(is_labelled(.data)){
+    igraph::vertex_attr(as_igraph(.data), "name")  
+  } else {
+    indices <- seq.int(net_nodes(.data))
+    paste0("N", gsub("\\s", "0", format(indices, width=max(nchar(indices)))))
+  }
 }
 
 #' @rdname measure_attributes

R/measure_features.R

@@ -256,7 +256,7 @@ net_smallworld <- function(.data,
 #' @export
 net_scalefree <- function(.data){
   if(missing(.data)) {expect_nodes(); .data <- .G()}
-  out <- igraph::fit_power_law(node_degree(.data, normalized = FALSE))
+  out <- igraph::fit_power_law(node_deg(.data))
   if ("KS.p" %in% names(out)) {
     if(out$KS.p < 0.05) 
       cat(paste("Note: Kolgomorov-Smirnov test that data",