Merge pull request #263 from snlab-ch/develop

v0.13.2

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: migraph
 Title: Tools for Multimodal Network Analysis
-Version: 0.13.1
-Date: 2022-12-05
+Version: 0.13.2
+Date: 2022-12-20
 Description: A set of tools for analysing multimodal networks.
    All functions operate with matrices, edge lists, 
    and 'igraph', 'network', and 'tidygraph' objects,
@@ -48,10 +48,12 @@ Suggests:
     oaqc,
     readxl,
     Rgraphviz,
+    RSiena,
     rmarkdown,
     roxygen2,
     rsconnect,
-    testthat
+    testthat,
+    xml2
 Authors@R: 
     c(person(given = "James",
              family = "Hollway",

NAMESPACE

@@ -35,8 +35,10 @@ S3method(as_network,network)
 S3method(as_network,network.goldfish)
 S3method(as_network,siena)
 S3method(as_network,tbl_graph)
+S3method(as_siena,igraph)
 S3method(as_tidygraph,data.frame)
 S3method(as_tidygraph,igraph)
+S3method(as_tidygraph,list)
 S3method(as_tidygraph,matrix)
 S3method(as_tidygraph,network)
 S3method(as_tidygraph,network.goldfish)
@@ -238,6 +240,7 @@ export(as_graphAM)
 export(as_igraph)
 export(as_matrix)
 export(as_network)
+export(as_siena)
 export(as_tidygraph)
 export(autographr)
 export(autographs)
@@ -423,7 +426,9 @@ export(node_weak_components)
 export(play_diffusion)
 export(play_diffusions)
 export(play_learning)
+export(read_dynetml)
 export(read_edgelist)
+export(read_matrix)
 export(read_nodelist)
 export(read_pajek)
 export(read_ucinet)
@@ -636,6 +641,7 @@ importFrom(tidygraph,bind_edges)
 importFrom(tidygraph,is.tbl_graph)
 importFrom(tidygraph,mutate)
 importFrom(tidygraph,rename)
+importFrom(tidygraph,tbl_graph)
 importFrom(tidygraph,with_graph)
 importFrom(tidyr,pivot_longer)
 importFrom(utils,askYesNo)

NEWS.md

@@ -1,3 +1,22 @@
+# migraph 0.13.2
+
+## Package
+
+- Updated README with better structuring and explanation
+  - Also improved figure quality
+
+## Makes
+
+- Added `read_matrix()` for importing CSVs of adjacency/incidence matrices
+- Added `read_dynetml()` for importing DynetML .xml files (closed #261)
+
+## Manipulations
+
+- Added list method for `as_tidygraph()` for merging nodelists and edgelists
+  - Note that a named list is expected, with names "nodes" and "ties"
+- Added igraph method for `as_siena()`
+  - Note that this is a WIP proof of concept, and will currently only create the DV
+
 # migraph 0.13.1
 
 ## Package

R/make_read.R

@@ -19,12 +19,13 @@
 #' @param sv Allows users to specify whether their csv file is
 #' `"comma"` (English) or `"semi-colon"` (European) separated.
 #' @param ... Additional parameters passed to the read/write function.
-#' @return The `read_edgelist()` and `read_nodelist()` functions will import
+#' @return `read_edgelist()` and `read_nodelist()` will import
 #' into edgelist (tibble) format which can then be coerced or combined into
 #' different graph objects from there.
 #'
-#' The `read_pajek()` and `read_ucinet()` functions will import into
+#' `read_pajek()` and `read_ucinet()` will import into
 #' a tidygraph format, since they already contain both edge and attribute data.
+#' `read_matrix()` will import into tidygraph format too.
 #' Note that all graphs can be easily coerced into other formats
 #' with `{migraph}`'s `as_` methods.
 #'
@@ -66,6 +67,34 @@
 #' @seealso [as]
 NULL
 
+#' @describeIn read Reading adjacency matrices from Excel/csv files
+#' @export
+read_matrix <- function(file = file.choose(),
+                          sv = c("comma", "semi-colon"),
+                          ...) {
+  sv <- match.arg(sv)
+  if (grepl("csv$", file)) {
+    if (sv == "comma") {
+      out <- read.csv(file, ...) # For US
+    } else {
+      out <- read.csv2(file, ...) # For EU
+    }
+  } else if (grepl("xlsx$|xls$", file)) {
+    if(requireNamespace("readxl", quietly = TRUE)){
+      out <- readxl::read_excel(file, ...)  
+    } else stop("Please install `readxl` from CRAN to import Excel files.")
+  }
+  if((dim(out)[1]+1) == dim(out)[2])
+    out <- out[,-1]
+  if(!is.null(colnames(out)) & 
+     all(colnames(out) == paste0("X",seq_along(colnames(out)))))
+    colnames(out) <- NULL
+  if(!is.null(colnames(out)) & is.null(rownames(out)) &
+     dim(out)[1] == dim(out)[2])
+    rownames(out) <- colnames(out)
+  as_tidygraph(as.matrix(out))
+}
+
 #' @describeIn read Reading edgelists from Excel/csv files
 #' @export
 read_edgelist <- function(file = file.choose(),
@@ -499,3 +528,63 @@ write_ucinet <- function(object,
   }
   close(UCINET.data)
 }
+
+#' @describeIn read Reading DynetML files
+#' @export
+read_dynetml <- function(file = file.choose()) {
+  if(!requireNamespace("xml2", quietly = TRUE)){
+    stop("Please install `xml2` from CRAN to import DynetML files.")
+  } else {
+
+    name <- type <- nodeset <- target <- value <- NULL
+
+    xmlfile <- xml2::read_xml(file)
+    xmllist <- xml2::as_list(xmlfile)
+
+    # Getting nodeset
+    # to deal with legacy constructions:
+    if("MetaMatrix" %in% names(xmllist$DynamicNetwork))
+      nodesets <- xmllist$DynamicNetwork$MetaMatrix$nodes else
+        nodesets <- xmllist$DynamicNetwork$MetaNetwork$nodes
+    nodesets <- dplyr::coalesce(unlist(lapply(nodesets, 
+                                              function(x) ifelse(is.null(attr(x, "id")),
+                                                                 NA_character_, attr(x, "id")))),
+                                unlist(lapply(nodesets, 
+                                              function(x) ifelse(is.null(attr(x, "type")),
+                                                                 NA_character_, attr(x, "type")))))
+    # to deal with legacy constructions:
+    if("MetaMatrix" %in% names(xmllist$DynamicNetwork)){
+      nodesets <- unname(rep(nodesets, vapply(xmllist$DynamicNetwork$MetaMatrix$nodes,
+                                              function(x) length(x), numeric(1))))
+    } else
+      nodesets <- unname(rep(nodesets, vapply(xmllist$DynamicNetwork$MetaNetwork$nodes,
+                                              function(x) length(x), numeric(1)))) 
+
+    # Getting nodes
+    nodes <- xml2::as_list(xml2::xml_find_all(xmlfile, ".//node"))
+    nodes <- dplyr::bind_rows(lapply(nodes, function(x){
+      values <- sapply(x$properties, function(y) attr(y, "value"))
+      attrs <- sapply(x$properties, function(y) attr(y, "name"))
+      names(values) <- attrs
+      c(name = attr(x, "id"), values)
+    }))
+    # Add nodeset information if necessary
+    if(length(unique(nodesets))==2)
+      nodes <- nodes %>% dplyr::mutate(type = nodesets == unique(nodesets)[2]) %>% 
+      dplyr::select(name, type, dplyr::everything()) else if (length(unique(nodesets))>2)
+        nodes <- nodes %>% dplyr::mutate(nodeset = nodesets) %>% 
+      dplyr::select(name, nodeset, dplyr::everything())
+
+    # Getting edges
+    edgelist <- xml2::xml_attrs(xml2::xml_find_all(xmlfile, ".//edge"))
+    # to deal with legacy constructions:
+    if(length(edgelist)==0) edgelist <- xml2::xml_attrs(xml2::xml_find_all(xmlfile, ".//link"))
+    edgelist <- as.data.frame(t(sapply(edgelist, function(x) x, simplify = TRUE)))
+    edgelist$type <- NULL
+    edgelist$value <- as.numeric(edgelist$value)
+    edgelist <- dplyr::filter(edgelist, source %in% nodes$name & target %in% nodes$name)
+    edgelist <- dplyr::filter(edgelist, value != 0)
+    as_tidygraph(list(nodes = nodes, ties = edgelist))
+  }
+}
+

R/manip_as.R

@@ -495,10 +495,10 @@ as_igraph.siena <- function(object, twomode = NULL) {
   }
 
   .get_attributes <- function(ndy, x, name = NULL) {
-    for(d in seq_len(dim(ndy)[3])) {
+    for(d in seq_len(dim(ndy)[2])) {
       x <- add_node_attribute(x,
                               attr_name = paste0(name, "_", "t", d),
-                              as.vector(ndy[,,d]))
+                              as.vector(ndy[,d]))
     }
     x
   }
@@ -577,6 +577,20 @@ as_tidygraph.data.frame <- function(object, twomode = FALSE) {
   tidygraph::as_tbl_graph(as_igraph(object))
 }
 
+#' @importFrom tidygraph tbl_graph
+#' @export
+as_tidygraph.list <- function(object, twomode = FALSE) {
+  if(!is.null(names(object))){
+    if("nodes" %in% names(object) & "ties" %in% names(object)){
+      tidygraph::tbl_graph(nodes = object[["nodes"]],
+                           edges = object[["ties"]])
+    } else if ("nodes" %in% names(object) & "edges" %in% names(object)){
+      tidygraph::tbl_graph(nodes = object[["nodes"]],
+                           edges = object[["edges"]])
+    } else stop("Please name the list elements 'nodes' and 'ties'.")
+  } else stop("Please name the list elements 'nodes' and 'ties'.")
+}
+
 #' @export
 as_tidygraph.matrix <- function(object, twomode = FALSE) {
   tidygraph::as_tbl_graph(as_igraph(object))
@@ -719,19 +733,42 @@ as_network.siena <- function(object, twomode = FALSE) {
 
 # RSiena ####
 
-# #' @rdname as
-# #' @export
-# as_siena <- function(object,
-#                       twomode = FALSE) UseMethod("as_siena")
-
-# #' @export
-# as_siena.tbl_graph <- function(object, twomode = FALSE){
-#   RSiena::sienaDependent()
-#   RSiena::coCovar()
-#   RSiena::varCovar()
-#   RSiena::sienaDependent()
-#   RSiena::sienaDataCreate()
-# }
+#' @rdname as
+#' @export
+as_siena <- function(object,
+                      twomode = FALSE) UseMethod("as_siena")
+
+#' @export
+as_siena.igraph <- function(object, twomode = FALSE){
+  if(!requireNamespace("RSiena", quietly = TRUE)){
+    stop("Please install `RSiena` from CRAN to import DynetML files.")
+  } else {
+    # First separate out the dependent ties
+    nets <- network_tie_attributes(object)
+    ties <- unique(gsub("_t[0-9]","",nets))
+    waves <- max(vapply(strsplit(nets, "_t"), function(t) as.numeric(t[2]), numeric(1)))
+    depnet <- ties[1]
+    depnetArray <- simplify2array(lapply(1:waves, 
+                                        function(t) as_matrix(to_uniplex(object, 
+                                                           paste0(depnet, "_t", t)))))
+    depnet <- RSiena::sienaDependent(depnetArray, 
+                           type = ifelse(is_twomode(object) | twomode,
+                                         "bipartite", "oneMode"))
+
+    # nodeatts <- network_node_attributes(object)
+    # nodeatts <- nodeatts[nodeatts != "name"]
+    # # Add constant covariates
+    # consatts <- nodeatts[!grepl("_t[0-9]",nodeatts)]
+    # consvars <- lapply(consatts, function(cons) 
+    #   RSiena::coCovar(node_attribute(object, cons)))
+    # names(consvars) <- consatts
+    # .newEnv <- new.env(parent=globalenv())
+    # list2env(consvars, envir = .newEnv)
+    # RSiena::varCovar()
+
+    RSiena::sienaDataCreate(depnet)
+  }
+}
 
 # graphAM ####
 

R/measure_centrality.R

@@ -1,4 +1,4 @@
-#' Measures of node and tie centrality
+#' Measures of node centrality
 #'
 #' @description
 #'   These functions calculate common centrality measures for one- and two-mode networks.

R/model_tests.R

@@ -156,5 +156,5 @@ plot.network_test <- function(x, ...,
   }
   p + ggplot2::theme_classic() + ggplot2::geom_density() +
     ggplot2::geom_vline(ggplot2::aes(xintercept = x$testval),
-                        color="red", size=1.2) + ggplot2::ylab("Density")
+                        color="red", linewidth=1.2) + ggplot2::ylab("Density")
 }