Merge branch 'v0.2' into fix67

NAMESPACE

@@ -2,9 +2,13 @@
 
 S3method(as_pkgrefs,default)
 S3method(as_pkgrefs,sessionInfo)
+S3method(convert_edgelist,default)
+S3method(convert_edgelist,rang)
+S3method(convert_edgelist,ranglet)
 S3method(print,rang)
 S3method(print,ranglet)
 export(as_pkgrefs)
+export(convert_edgelist)
 export(dockerise)
 export(dockerise_rang)
 export(dockerize)

R/edgelist.R

@@ -0,0 +1,56 @@
+#' Convert Data Structures to rang edgelist
+#'
+#' This generic function converts several data structures provided by rang into an edgelist of package dependencies.
+#' @param x, supported data structures are `rang` and `ranglet` S3 objects
+#' @param ..., not used
+#' @return a data frame of directed edges of dependencies
+#' @details the resulting data frame can be converted to an igraph object for plotting and analysis via the function [igraph::graph_from_data_frame()]
+#' @export
+#' @examples
+#' \donttest{
+#' if (interactive()) {
+#'     graph <- resolve(pkgs = c("openNLP", "LDAvis", "topicmodels", "quanteda"),
+#'                 snapshot_date = "2020-01-16")
+#'                 
+#'     # dependency edgelist of a single package
+#'     convert_edgelist(graph$ranglets[[1]])
+#'     
+#'     # full dependency edgelist
+#'     convert_edgelist(graph)
+#' }
+#' }
+convert_edgelist <- function(x, ...) {
+    UseMethod("convert_edgelist", x)
+}
+
+#' @rdname convert_edgelist
+#' @export
+convert_edgelist.default <- function(x, ...){
+    stop(paste("don't know how to convert an object of type",class(x),"to a rang edgelist"), call. = FALSE)
+}
+
+#' @rdname convert_edgelist
+#' @export
+convert_edgelist.ranglet <- function(x, ...){
+    output <- data.frame(from = x$pkgref, to = .extract_queryable_dependencies(x$original, x$no_enhances, x$no_suggests))
+    for (dep in x$deps) {
+        if (!.is_terminal_node(dep, x$no_enhances)) {
+          el <- data.frame(from = unique(dep$x_pkgref), to = .extract_queryable_dependencies(dep, x$no_enhances, x$no_suggests))
+          output <- rbind(output, el)
+       }
+    }
+    output
+}
+
+#' @rdname convert_edgelist
+#' @export
+convert_edgelist.rang <- function(x, ...){
+    if(length(x$ranglets)!=0){
+      el <- do.call("rbind",lapply(x$ranglets,convert_edgelist))
+      rownames(el) <- NULL
+      return(el)
+    } else{
+      return(data.frame(from = character(0),to = character(0)))
+    }
+
+}

R/installation.R

@@ -135,9 +135,9 @@
     } else {
         lib_as_character <- paste0("\"", lib, "\"")
     }
-    if(!is.null(rang$bioc_version)){
+    if(!is.null(rang$bioc_version)) {
       bioc_txt <- paste0(", bioc_mirror = \"", bioc_mirror,rang$bioc_version,"/","\"")
-    } else{
+    } else {
       bioc_txt <- NULL
     }
     writeLines(paste0("## rang::export_rang(rang = rang, path = \"", path, "\", verbose = ",
@@ -230,7 +230,7 @@
                           source = source, uid = uid,
                           cache_dir = cache_dir, verbose = verbose)
         }
-        if(source == "bioc"){
+        if(source == "bioc") {
             .cache_pkg_bioc(x = x, version = version, cache_dir = cache_dir,
                             bioc_mirror = bioc_mirror,bioc_version = rang$bioc_version, verbose = verbose)
         }
@@ -289,16 +289,16 @@
     return(dockerfile_content)
 }
 
-.generate_docker_readme <- function(output_dir,image){
-  file.create(file.path(output_dir,"README"))
-  con <- file(file.path(output_dir,"README"), open="w")
-  readme <- readLines(system.file("readme_template.txt", package = "rang"))
-  readme <- gsub("__DATE__",Sys.Date(),readme)
-  readme <- gsub("__OUTPUT__",output_dir,readme)
-  readme <- gsub("__IMAGE__",image,readme)
-  writeLines(readme,file.path(output_dir,"README"))
-  close(con)
-  invisible(readme)
+.generate_docker_readme <- function(output_dir,image) {
+    file.create(file.path(output_dir,"README"))
+    con <- file(file.path(output_dir,"README"), open="w")
+    readme <- readLines(system.file("readme_template.txt", package = "rang"))
+    readme <- gsub("__DATE__",Sys.Date(),readme)
+    readme <- gsub("__OUTPUT__",output_dir,readme)
+    readme <- gsub("__IMAGE__",image,readme)
+    writeLines(readme,file.path(output_dir,"README"))
+    close(con)
+    invisible(readme)
 }
 
 #' Export The Resolved Result As Installation Script
@@ -335,6 +335,10 @@ export_rang <- function(rang, path, rang_as_comment = TRUE, verbose = TRUE, lib
     if (utils::compareVersion(rang$r_version, "2.1") == -1) {
         stop("`export_rang` doesn't support this R version (yet).")
     }
+    if (length(rang$ranglets) == 0) {
+        warning("Nothing to export.")
+        return(invisible(NULL))
+    }
     cran_mirror <- .normalize_url(cran_mirror)
     if (isTRUE(check_cran_mirror)) { ## probably need to stop this also if #17 is implemented
         if (isFALSE(.query_mirror_validity(cran_mirror))) {
@@ -405,6 +409,10 @@ dockerize <- function(rang, output_dir, materials_dir = NULL, image = c("r-ver",
                       bioc_mirror = "https://bioconductor.org/packages/",
                       no_rocker = FALSE,
                       debian_version = c("lenny", "etch", "squeeze", "wheezy", "jessie", "stretch")) {
+    if (length(rang$ranglets) == 0) {
+        warning("Nothing to dockerize.")
+        return(invisible(NULL))
+    }
     if (missing(output_dir)) {
         stop("You must provide `output_dir`.", call. = FALSE)
     }

R/resolve.R

@@ -366,17 +366,6 @@ print.rang <- function(x, all_pkgs = FALSE, ...) {
     }
 }
 
-convert_edgelist <- function(x) {
-    output <- data.frame(x = x$pkg, y = .extract_queryable_dependencies(x$original, x$no_enhances, x$no_suggests))
-    for (dep in x$deps) {
-        if (!.is_terminal_node(dep, x$no_enhances)) {
-            el <- data.frame(x = unique(dep$x), y = .extract_queryable_dependencies(dep, x$no_enhances, x$no_suggests))
-            output <- rbind(output, el)
-        }
-    }
-    output
-}
-
 ## extract all the pkgrefs of deps and pkgs: for .sysreqs
 .extract_pkgrefs <- function(rang) {
     original_pkgrefs <- names(rang$ranglets)

tests/testthat/test_dockerize.R

@@ -7,6 +7,13 @@ test_that("defensive programming", {
     expect_error(dockerize(graph, output_dir = tempdir()))
 })
 
+test_that("empty rang dockerize #75", {
+    graph <- readRDS("../testdata/rang_ok.RDS")
+    graph$ranglets <- list()
+    expect_warning(x <- dockerize(graph, output_dir = .generate_temp_dir()))
+    expect_equal(x, NULL)
+})
+
 test_that("integration of #13 in dockerize()", {
     rang_ok <- readRDS("../testdata/rang_ok.RDS")
     temp_dir <- .generate_temp_dir()

tests/testthat/test_edgelist.R

@@ -0,0 +1,30 @@
+test_that("convert ranglet to edgelist", {
+  graph <- readRDS("../testdata/graph.RDS")
+  el <- convert_edgelist(graph$ranglets[[1]])
+  expect_s3_class(el,"data.frame")
+  expect_equal(nrow(el),4L)
+})
+
+test_that("convert rang to edgelist", {
+  graph <- readRDS("../testdata/graph.RDS")
+  el <- convert_edgelist(graph)
+  expect_s3_class(el,"data.frame")
+  expect_equal(nrow(el),121L)
+})
+
+test_that("convert edgelist empty rang", {
+  graph <- readRDS("../testdata/rang_ok.RDS")
+  graph$ranglets <- list()
+  el <- convert_edgelist(graph)
+  expect_s3_class(el,"data.frame")
+  expect_equal(nrow(el),0L)
+
+})
+
+
+test_that("convert edgelist error", {
+  expect_error(convert_edgelist("abc"))
+  expect_error(convert_edgelist(42))
+  expect_error(convert_edgelist(cbind(1:5,6:10)))
+})
+

tests/testthat/test_expost_rang.R

@@ -115,9 +115,16 @@ test_that("issue #38", {
 })
 
 test_that("Bioconductor <2.0",{
-  expect_error(.bioc_package_history(bioc_version = "1.9"))
+    expect_error(.bioc_package_history(bioc_version = "1.9"))
 })
 
 test_that("Bioconductor new release",{
-  expect_equal(.query_biocver("2023-01-01")$version,"3.16")
-})
+    expect_equal(.query_biocver("2023-01-01")$version,"3.16")
+})
+
+test_that("empty rang export, #75", {
+    graph <- readRDS("../testdata/rang_ok.RDS")
+    graph$ranglets <- list()
+    expect_warning(x <- export_rang(graph, path = tempfile()))
+    expect_equal(x, NULL)
+})