Merge pull request #91 from snlab-ch/develop

Fixed CRAN bugs on as_matrix and plot_releases

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: migraph
 Title: Multimodal and Multilevel Network Analysis
-Version: 0.6.5
-Date: 2021-05-07
+Version: 0.6.6
+Date: 2021-05-13
 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) 

NAMESPACE

@@ -67,6 +67,9 @@ importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_grey)
 importFrom(httr,GET)
 importFrom(httr,content)
+importFrom(httr,http_error)
+importFrom(httr,stop_for_status)
+importFrom(httr,warn_for_status)
 importFrom(igraph,V)
 importFrom(igraph,bipartite.projection)
 importFrom(igraph,degree)

NEWS.md

@@ -1,8 +1,22 @@
+# migraph 0.6.6
+
+## Classes
+
+* Fixed bug in `as_matrix()` with frame matrix by dropping (rarely necessary) functionality
+  * Improved handling of weights column in three-column edgelists
+  * Improved documentation of `as_` functions
+
+## Plotting
+
+* Fixed bugs in `plot_releases()` with more graceful handling of http errors
+  * Added online condition to example in documentation
+  * Specified encoding for more silent operation
+
 # migraph 0.6.5
 
 ## Package
 
-* Removed unused package dependencies (R6, ggraph)
+* Removed unused package dependencies (`{R6}`, `{ggraph}`)
 * Avoided M1mac check issue by dropping sensitive `netlm()` test
 * Added some tests
 

R/coercion.R

@@ -1,11 +1,15 @@
-#' migraph-consistent object classes 
+#' Coercion between migraph-consistent object classes 
 #' 
-#' The `as_` functions in `{migraph}`
-#' typically accept edgelists (as data frames), matrices,
-#' igraph graph objects, or tidygraph tbl_graph objects,
-#' coercing them into the class designated in the function name.
+#' The `as_` functions in `{migraph}` coerce objects
+#' between several common classes of social network objects.
+#' These include:
+#' - adjacency and incidence matrices
+#' - edgelists (as data frames)
+#' - `{igraph}` `graph` objects
+#' - `{tidygraph}` `tbl_graph` objects
+#' - `{network}` `network` objects
 #' @name coercion
-#' @param object A data frame edgelist, matrix, igraph, or tidygraph object.
+#' @param object A data frame edgelist, matrix, igraph, tidygraph, or network object.
 #' @param twomode An option to override the heuristics for distinguishing incidence
 #' from adjacency matrices. By default FALSE.
 #' @details Behaviour is a little different depending on the data format.
@@ -16,17 +20,13 @@
 #' If the data frame is a 3 column edgelist,
 #' then the third column will be used as 
 #' the cell values or tie weights.
-#' If the data frame is more than 3 columns,
-#' the first column is full of character strings (i.e. is named)
-#' and the second column is numeric (e.g. 0 and 1)
-#' then it will be assumed that this is a matrix
-#' embedded in a data frame.
 #' 
 #' Incidence matrices are typically inferred from unequal dimensions,
 #' but since in rare cases a matrix with equal dimensions may still
 #' be an incidence matrix, an additional argument `twomode` can be
 #' specified to override this heuristic.
-#' This information is usually already embedded in igraph and tidygraph objects.
+#' This information is usually already embedded in `{igraph}`, 
+#' `{tidygraph}`, and `{network}` objects.
 #' @examples
 #' test <- data.frame(id1 = c("A","B","B","C","C"),
 #'                    id2 = c("I","G","I","G","H"))
@@ -58,22 +58,25 @@ as_matrix <- function(object){
   } else if (is.matrix(object)) {
     mat <- object
   } else if (is.data.frame(object)){
-    if(is.character(object[,1]) & ncol(object)>2 & is.numeric(object[1,2])){
-      out <- object
-      row.names(out) <- out[,1]
-      out[,1] <- NULL
-      out <- as.matrix(out)
-    } else {
-      if (ncol(object)==2) {
-        object <- as.data.frame(table(object[,1], object[,2]))
-      }
-      if (ncol(object)==3) {
-        nodes1 <- as.character(unique(object[,1]))
-        nodes2 <- as.character(unique(object[,2]))
-        out <- structure(as.numeric(object[,3]), 
-                         .Dim = c(as.integer(length(nodes1)), as.integer(length(nodes2))), 
-                         .Dimnames = list(nodes1, nodes2))
+    if (ncol(object) == 2) { # Adds a third (weight) column to a two-column edgelist
+      object <- as.data.frame(table(object[,1], object[,2]))
+    }
+    if (ncol(object) == 3) {
+      # object <- object[order(object[,1], object[,2]),]
+      nodes1 <- as.character(unique(object[,1]))
+      nodes1 <- sort(nodes1)
+      nodes2 <- as.character(unique(object[,2]))
+      nodes2 <- sort(nodes2)
+      if(nrow(object) != length(nodes1)*length(nodes2)){
+        allcombs <- expand.grid(object[,1:2], stringsAsFactors = FALSE)
+        allcombs <- subset(allcombs, !duplicated(allcombs))
+        object <- merge(allcombs, object, all.x = TRUE)
+        object <- object[order(object[,2], object[,1]),]
+        object[is.na(object)] <- 0
       }
+      out <- structure(as.numeric(object[,3]), 
+                       .Dim = c(as.integer(length(nodes1)), as.integer(length(nodes2))), 
+                       .Dimnames = list(nodes1, nodes2))
     }
     mat <- out
   }
@@ -126,7 +129,7 @@ as_igraph <- function(object, twomode = FALSE){
 #' @export
 as_tidygraph <- function(object, twomode = FALSE){
 
-  if(missing(object) | is.tbl_graph(object)){
+  if(missing(object)){
     tidy <- object
   } else if (is.igraph(object)) {
     tidy <- tidygraph::as_tbl_graph(object)

R/plot.R

@@ -86,7 +86,7 @@ plot.blockmodel <- function(x, ...){
 #' The function will take a data frame that details this information,
 #' or more usefully, a Github repository listing.
 #' @param repo the github repository to track, e.g. "snlab-ch/migraph"
-#' @importFrom httr GET content
+#' @importFrom httr GET content warn_for_status stop_for_status http_error
 #' @importFrom jsonlite fromJSON
 #' @importFrom tibble as_tibble
 #' @importFrom stats ave
@@ -99,14 +99,32 @@ plot.blockmodel <- function(x, ...){
 #' @source https://benalexkeen.com/creating-a-timeline-graphic-using-r-and-ggplot2/
 #' @return A ggplot graph object
 #' @examples
+#' if(!httr::http_error("https://api.github.com/repos/snlab-ch/migraph/releases")){
 #' plot_releases("snlab-ch/migraph")
+#' }
 #' @export
 plot_releases <- function(repo) {
 
   if (!is.data.frame(repo)) {
 
     get_releases <- function(repo) {
 
+      repo <- paste0("https://api.github.com/repos/", repo, "/releases")
+      # if (httr::http_error(df)) { # network is down = message (not an error anymore)
+      #   message("No internet connection or data source broken.")
+      #   return(NULL)
+      # } else { # network is up = proceed to GET via httr
+
+      df <- httr::GET(repo, query = list(state = "all", per_page = 100, page = 1))
+      httr::stop_for_status(df)
+      httr::warn_for_status(df)
+      df <- httr::content(df, type = "text", encoding = "UTF-8")
+      df <- jsonlite::fromJSON(df, flatten = TRUE)
+      df <- df[, c("tag_name", "url", "published_at")]
+      df$date <- stringr::str_remove(df$published_at, "T.*$")
+      df$date <- lubridate::ymd(stringr::str_replace(df$date,
+                                                     "-[:digit:]*$", "-01"))
+
       code_milestone <- function(tag_name) {
         tags <- c(tag_name, "v0.0.0")
         test <- lapply(stringr::str_split(stringr::str_remove(tags, "v"), "\\."),
@@ -120,16 +138,9 @@ plot_releases <- function(repo) {
                       "Minor", "Major"))[-length(tags)]
       }
 
-      df <- paste0("https://api.github.com/repos/", repo, "/releases")
-      df <- httr::GET(df, query = list(state = "all", per_page = 100, page = 1))
-      df <- httr::content(df, type = "text")
-      df <- jsonlite::fromJSON(df, flatten = TRUE)
-      df <- df[, c("tag_name", "url", "published_at")]
-      df$date <- stringr::str_remove(df$published_at, "T.*$")
-      df$date <- lubridate::ymd(stringr::str_replace(df$date,
-                                                     "-[:digit:]*$", "-01"))
       df$milestone <- code_milestone(df$tag_name)
       df
+      # }
     }
 
     df <- get_releases(repo)
@@ -212,12 +223,12 @@ plot_releases <- function(repo) {
   )
 
   # Show text for each month
-  timeline_plot <- timeline_plot + ggplot2::geom_text(data=month_df,
+  timeline_plot <- timeline_plot + ggplot2::geom_text(data = month_df,
                                                       ggplot2::aes(x = month_date_range,
                                                                    y =-0.1, label = month_format),
                                                       size = 2.5, vjust = 0.5, color = "black", angle=90)
-  # Show year text
-  timeline_plot <- timeline_plot + ggplot2::geom_text(data = year_df,
+  # Show year text if applicable
+  if(nrow(year_df)>0) timeline_plot <- timeline_plot + ggplot2::geom_text(data = year_df,
                                                       ggplot2::aes(x = year_date_range,
                                                                    y = -0.2,
                                                                    label = year_format,

tests/testthat/test-coercion.R

@@ -1,18 +1,15 @@
-data1 <- data.frame(ID = LETTERS[1:3],
-                    G = c(0,1,1),
-                    H = c(0,0,1),
-                    I = c(1,1,0))
-
 mat1 <- matrix(c(0,1,1,0,0,1,1,1,0),3,3)
 rownames(mat1) <- LETTERS[1:3]
 colnames(mat1) <- LETTERS[7:9]
 
-data2 <- data.frame(id1 = c("A","B","B","C","C"),
+data1 <- data.frame(id1 = c("A","B","B","C","C"),
                     id2 = c("I","G","I","G","H"))
+data2 <- data1
+data2$weight <- 1
 
 test_that("data frame converted to matrix correctly",{
+  expect_equal(as_matrix(data1), mat1)
   expect_equal(as_matrix(data2), mat1)
-  expect_equal(as_matrix(data1), mat1) # fix issue with convert function that is not properly converting the data1 input
 })
 
 test_that("as_matrix converts correctly",{

tests/testthat/test-plot_releases.R

@@ -1,6 +1,10 @@
 test_that("Plotting function visualises historical milestones/releases of a repository", {
-  skip_on_os("mac")
-  testplot <- plot_releases("globalgov/qData")
+  # skip_on_os("mac")
+  # testplot <- plot_releases("snlab-ch/migraph")
+  testdf <- data.frame(tag_name = c("v0.1.0","v0.1.1"),
+                       date = as.Date(c("2021-04-01","2021-05-01")),
+                       milestone = c("Minor","Patch"))
+  testplot <- plot_releases(testdf)
   expect_true(is.list(testplot))
   expect_length(testplot, 9)
   expect_named(testplot[1:3], c("data", "layers", "scales"))