R/deps.R

In lgatto/biocpkgs: Learning about Bioconductor packages

##' @importFrom BiocManager repositories
full_pkg_dep_graph <- function(which = c("BioCsoft", "BioCann", "BioCexp", "CRAN")) {
    which <- match.arg(which)
    biocUrl <- repositories()[which]
    pkgDepTools::makeDepGraph(biocUrl, type = "source", dosize = FALSE)
}

##' @importFrom graph acc subGraph
##' @importFrom graph nodes
subset_pkg_dep_graph <- function(pkgs, g) {
    if (!all(ingr <- pkgs %in% nodes(g))) {
        warning(sum(!ingr), " out of ", length(pkgs),
                " packages not found.", call. = FALSE)
        pkgs <- pkgs[ingr]
        if (length(pkgs) == 0)
            return(g)
    }
    deps <- unlist(sapply(acc(g, pkgs), names))
    pkgs <- unique(c(pkgs, deps))
    subGraph(pkgs, g)
}

##' This function takes a list of packages and build the their
##' dependency graph using all packages of a repository (for example
##' all Bioconductor software or CRAN packages). The packages of
##' interest and all their dependencies are used to create the graph.
##'
##' The dependency graph is of class `graphNL`. Plotting the graph
##' also relies on the `Rgraphviz` packge. None of these packages are
##' attached to the search path, but users might need to load them if
##' they wish to manipulate the graph and customise the visualisation.
##'
##' @title Package dependency graphs
##' @param pkgs The name of the package(s) to generate and plot the
##'     dependency graph of. For plotting, it can be a list (each
##'     element of the list being highlighted using different colours)
##'     or a vector (all highlighted with the same colour) of package
##'     names to be highlighted.
##' @param which What package repository to use to calculate
##'     dependency graphs. One of `"BioCsoft"`(default, Bioconductor
##'     software packages), `"BioCann"` (Bioconductor annotation
##'     packages), `"BioCexp"` (Bioconductor experiment packages) or
##'     `"CRAN"` (CRAN packages).
##' @return An object of class `graphNEL` from the package
##'     `graph`. The plotting function invisibly returns a `Ragraph`
##'     object (from the `Rgraphviz` package).
##' @export
##' @rdname deps
##' @author Laurent Gatto
##' @examples
##' p <- c("MSnbase", "mzR")
##' g <- pkg_dep_graph(pkgs = p)
##' g
##' plot_pkg_dep_graph(g, fs = 25)
##' plot_pkg_dep_graph(g, pkgs = p, fs = 25)
##' plot_pkg_dep_graph(g, pkgs = list("MSnbase", "mzR"),
##'                    colour = c("steelblue", "yellow"),
##'                    fs = 25)
pkg_dep_graph <- function(pkgs,
                          which = c("BioCsoft", "BioCann", "BioCexp", "CRAN")) {
    g <- full_pkg_dep_graph(which)
    if (!missing(pkgs) && is.character(pkgs))
        g <- subset_pkg_dep_graph(pkgs, g)
    return(g)
}

##' @importFrom graph graph.par
set_graph_pars <- function()
    graph.par(list(edges = list(col = "grey", lty = "dotted", lwd = .5),
                   nodes = list(lwd = .5, cex = 5, fontsize = 2, cex = 1)))


##' @export
##' @rdname deps
##' @importFrom graph plot
##' @param gr A `graphNEL` package dependency graph, as generated by
##'     `pkg_dep_graph`.
##' @param sz The size of the nodes. Default is 20.
##' @param fs The font size. Default is 50.
##' @param colour A vector of colours to be used to highlight to
##'     packages. The length of this argument must be of same length
##'     as the `pkgs`.
##' @param edge_colour The colour of the edges. Default in
##'     `"#00000040"`.
plot_pkg_dep_graph <- function(gr, sz = 20, fs = 50,
                               pkgs, colour = "steelblue",
                               edge_colour = "#00000040") {
    fillcolor <- "#e0e0e0"
    if (!missing(pkgs))
        fillcolor <- set_edge_colours(gr, as.list(pkgs), colour)
    nn <- Rgraphviz::makeNodeAttrs(gr,
                                   height = sz, width = sz,
                                   fontsize = fs,
                                   fillcolor = fillcolor)
    set_graph_pars()
    ans <- plot(gr, nodeAttrs = nn,
                attrs = list(edge = list(color = edge_colour)))
    invisible(ans)
}

set_edge_colours <- function(gr, pkgs, colour = "steelblue",
                             names = FALSE) {
    if (length(colour) > 1) stopifnot(is.list(pkgs))
    else pkgs <- list(pkgs)
    stopifnot(length(pkgs) == length(colour))
    x <- nodes(gr)
    ans <- rep("white", length(x))
    for (i in seq_along(pkgs)) {
        .col <- colour[i]
        .pkgs <- pkgs[[i]]
        ans[x %in% .pkgs] <- .col
    }
    ## ans[x %in% mypks] <- "red"
    if (names) names(ans) <- x
    ans
}