Merge pull request #176 from snlab-ch/develop

Minor fixes in read_nodelist, read_edgelist and as_network methods

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: migraph
 Title: Multimodal and Multilevel Network Analysis
-Version: 0.8.10
-Date: 2021-12-08
+Version: 0.8.11
+Date: 2021-12-10
 Description: A set of tools that extend common social network analysis packages
    for analysing multimodal and multilevel networks.
    It includes functions for one- and two-mode (and sometimes three-mode) 

NEWS.md

@@ -1,3 +1,14 @@
+# migraph 0.8.11
+
+## Import and export
+- Fixed #172 by removing redundant header argument in `read_nodelist()` and
+  `read_edgelist()`
+
+## Package
+- Fixed #173 by extending `as_network()` method to convert correctly form
+  an `{igraph}` to a `{network}` object.
+- Removed `ggraphgrid()` documentation
+
 # migraph 0.8.10
 
 ## Import and export

R/as.R

@@ -348,13 +348,16 @@ as_network.network <- function(object) {
 
 #' @export
 as_network.matrix <- function(object) {
-  # Convert to adjacency matrix
-  out <- to_multilevel(object)
+  # Convert to adjacency matrix if not square already
+  if (nrow(object) != ncol(object)) {
+    out <- to_multilevel(object)
+  } else out <- object
   network::as.network(out, 
                       directed = is_directed(object),
                       bipartite   = ifelse(is_twomode(object),
                                            nrow(object),
                                            FALSE),
+                      loops = ifelse(sum(diag(out)) > 0, TRUE, FALSE),
                       ignore.eval = ifelse(is_weighted(object),
                                            FALSE, TRUE),
                       names.eval  = ifelse(is_weighted(object),
@@ -365,7 +368,8 @@ as_network.matrix <- function(object) {
 as_network.igraph <- function(object) {
   name <- type <- NULL
   attr <- as.data.frame(igraph::get.vertex.attribute(object))
-  attr <- subset(attr, select = c(-name, -type))
+  if ("name" %in% colnames(attr)) attr <- subset(attr, select = c(-name))
+  if ("type" %in% colnames(attr)) attr <- subset(attr, select = c(-type))
   out <- as_network(as_matrix(object, weight = is_weighted(object)))
   if (length(attr) > 0) {
     out <- network::set.vertex.attribute(out, names(attr), attr)

R/ggraphgrid.R

@@ -1,6 +1,7 @@
 #' Plot graph to grid
 #'
 #' For quick and easy graphing of networks to a grid plot
+#' @noRd
 #' @details The function uses approximate pattern matching
 #' to redistributes the coarse layouts on the square grid points, while
 #' preserving the topological relationships among the nodes (see Inoue et al. 2012). 

R/read.R

@@ -73,7 +73,7 @@ read_edgelist <- function(file = file.choose(),
       out <- read.csv2(file, header = TRUE, ...) # For EU
     }
   } else if (grepl("xlsx$|xls$", file)) {
-    out <- readxl::read_excel(file, header = TRUE, ...)
+    out <- readxl::read_excel(file, ...)
   }
   out
 }
@@ -103,6 +103,7 @@ write_edgelist <- function(object,
 #' @export
 read_nodelist <- function(file = file.choose(),
                           sv = c("comma", "semi-colon"),
+
                           ...){
   sv <- match.arg(sv)
   if (grepl("csv$", file)) {
@@ -112,7 +113,7 @@ read_nodelist <- function(file = file.choose(),
       out <- read.csv2(file, header = TRUE, ...) # For EU
     }
   } else if (grepl("xlsx$|xls$", file)) {
-    out <- readxl::read_excel(file, header = TRUE, ...)
+    out <- readxl::read_excel(file, ...)
   }
   out
 }

tests/testthat/test-grab.R

@@ -4,18 +4,32 @@ net <- as_tidygraph(data.frame(from = c("A", "B", "C", "D","E"),
 
 net2 <- as_tidygraph(data.frame(from = c("A", "B", "C", "D","E"),
                                 to = c("B", "C", "D", "E", "A"))) %>%
-  dplyr::mutate(friends = c("yes", "yes", "no", "no", "yes"))
+  dplyr::mutate(friends = c("yes", "yes", "no", "no", "yes")) %>%
+  igraph::set_edge_attr("weight", value = 1:5)
+
+net3 <- as_matrix(data.frame(from = c("A", "A", "B", "C", "D", "D", "E", "E"),
+                   to = c("B", "G", "C", "D", "E", "G", "A", "H")))
 
 name <- c("Lisa", "John", "Lily", "Ben", "Adam")
 
 friends <- c("yes", "yes", "no", "no", "yes")
 
 test_that("node_names works", {
   expect_equal(node_names(net), name)
+  expect_length(node_names(net), 5)
 })
 
 test_that("node_attribute works", {
   expect_equal(node_attribute(net2, "friends"), friends)
+  expect_length(node_attribute(net2, "friends"), igraph::vcount(net2))
+})
+
+test_that("edge_attribute works", {
+  expect_equal(edge_attribute(net2, "weight"), c(1, 2, 3, 4, 5))
+})
+
+test_that("edge_weights works", {
+  expect_equal(edge_weights(net2), edge_attribute(net2, "weight"))
 })
 
 test_that("graph_nodes works", {
@@ -25,3 +39,9 @@ test_that("graph_nodes works", {
 test_that("graph_edges works", {
   expect_false(graph_edges(net)==10)
 })
+
+test_that("graph_dims works", {
+  expect_equal(graph_dims(net3), c(5, 7))
+  expect_length(graph_dims(net3), 2)
+  expect_false(length(graph_dims(net3)) == 1)
+})

tests/testthat/test-to.R

@@ -56,8 +56,8 @@ test_that("to_undirected works",{
                ((as_matrix(ison_coleman) + t(as_matrix(ison_coleman))) > 0) * 1)
   expect_equal(to_undirected(as_matrix(southern_women)),
                as_matrix(southern_women))
-  expect_equal(unname(as_matrix(to_undirected(as_network(ison_coleman)))[1, ]),
-               c(rep(0,9),1,rep(0,6)))
+  expect_equal(as_matrix(to_undirected(as_network(ison_coleman))),
+               as_matrix(to_undirected(ison_coleman)))
 })
 
 test_that("to_onemode works",{