#!/usr/bin/Rscript getDependencies <- function(pkgs, dependencies = NA, available = NULL, installed = NULL , lib = .libPaths()[1L]) { oneLib <- length(lib) == 1L if(is.logical(dependencies) && is.na(dependencies)) dependencies <- c("Depends", "Imports", "LinkingTo") depends <- is.character(dependencies) || (is.logical(dependencies) && dependencies) if(depends && is.logical(dependencies)) dependencies <- c("Depends", "Imports", "LinkingTo", "Suggests") if(depends && !oneLib) { warning("Do not know which element of 'lib' to install dependencies into\nskipping dependencies") depends <- FALSE } bundles <- utils:::.find_bundles(available) for(bundle in names(bundles)) pkgs[ pkgs %in% bundles[[bundle]] ] <- bundle p0 <- unique(pkgs) miss <- !p0 %in% row.names(available) if(sum(miss)) { warning(sprintf(ngettext(sum(miss), "package %s is not available", "packages %s are not available"), paste(sQuote(p0[miss]), collapse=", ")), domain = NA) if (sum(miss) == 1L && !is.na(w <- match(tolower(p0[miss]), tolower(row.names(available))))) { warning(sprintf("Perhaps you meant %s ?", sQuote( row.names(available)[w])), call. = FALSE, domain = NA) } flush.console() } p0 <- p0[!miss] if(depends) { # check for dependencies, recursively p1 <- p0 # this is ok, as 1 lib only ## INSTALL prepends 'lib' to the libpath ## Here we are slightly more conservative libpath <- .libPaths() if(!lib %in% libpath) libpath <- c(lib, libpath) if ( missing(installed) ) installed <- installed.packages(lib.loc = libpath, fields = c("Package", "Version")) not_avail <- character() repeat { deps <- apply(available[p1, dependencies, drop = FALSE], 1L, function(x) paste(x[!is.na(x)], collapse=", ")) res <- utils:::.clean_up_dependencies2(deps, installed, available) not_avail <- c(not_avail, res[[2L]]) deps <- unique(res[[1L]]) ## R should not get to here, but be safe deps <- deps[!deps %in% c("R", pkgs)] if(!length(deps)) break pkgs <- c(deps, pkgs) p1 <- deps } if(length(not_avail)) { not_avail <- unique(not_avail) warning(sprintf(ngettext(length(not_avail), "dependency %s is not available", "dependencies %s are not available"), paste(sQuote(not_avail), collapse=", ")), domain = NA, call. = FALSE, immediate. = TRUE) flush.console() } for(bundle in names(bundles)) pkgs[ pkgs %in% bundles[[bundle]] ] <- bundle pkgs <- unique(pkgs) pkgs <- pkgs[pkgs %in% row.names(available)] if(length(pkgs) > length(p0)) { added <- setdiff(pkgs, p0) message(sprintf(ngettext(length(added), "also installing the dependency %s", "also installing the dependencies %s"), paste(sQuote(added), collapse=", ")), "\n", domain = NA) flush.console() } p0 <- pkgs } p0 } prep <- function() { if ( is.na(initted) ) { print("Prepping") initted <<- TRUE lib <- "/usr/lib64/R/library" libpath <- .libPaths() dependencies <<- c("Depends", "Imports" ) setRepositories( ind=c(1,2,3,4,5,6,7)) available <<- available.packages() installed <<- installed.packages(lib.loc = libpath, fields = c("Package", "Version")) orig <<- installed[installed[,"Priority"] %in% c("base","recommended"),] } } depList <- function( pkgs=NULL ) { pkgs <- getDependencies(pkgs, dependencies, available, orig, lib) # print(length(pkgs)) return(pkgs) } installed <- NA orig <- NA available <- NA dependencies <- NA initted <- NA lib <- NA libpath <- NA "%w/o%" <- function(x,y) x[!x %in% y] #-- x without y calc_buildorders <- function() { prep() # What can we attempt? scratch <- available.packages() # Some packages exist in multiple repos. Gotta punt that at the moment. scratch <- scratch[unique(row.names(scratch)),] scratch <- data.frame(scratch,stringsAsFactors=FALSE) # Record their dependencies. scratch$deps <- lapply(row.names(scratch),depList) # Copy deps for scratch space. scratch$depwork <- scratch$deps # Some bookkeeping columns. scratch$satisfied <- FALSE scratch$done <- FALSE scratch$iter <- -1 iter = 0 maxiters = 20 while ( ( length(row.names(scratch[scratch$satisfied==FALSE,])) > 0) & ( iter < maxiters ) ) { iter = iter + 1; scratch$satisfied = scratch$satisfied | scratch$Package == scratch$depwork got <- scratch[scratch$satisfied,]$Package scratch$depwork <- lapply(scratch$depwork,function(x) {x %w/o% got }) # Packages to be worked with this iteration. # scratch[scratch$satisfied & (!scratch$done) ,]$Package # On which pass did we get this batch? scratch[scratch$satisfied & (!scratch$done) ,]$iter = iter # And now we're done with this iteration, so: scratch$done = scratch$satisfied # Packages yet to be worked with. # row.names(scratch[scratch$satisfied==FALSE,]) ll <- length(row.names(scratch[scratch$satisfied==FALSE,])) cat(c(" Iteration ",iter,"; ",ll," packages remain.\n"),sep="") } return(scratch) } biglist <- calc_buildorders() biglist[biglist$iter==7,]$Package ## Print print('length of first iteration') length(biglist[biglist$iter==1,]$Package) file = "first_iteration.csv" print(sprintf('saving to file: %s', file)) write.table(biglist[biglist$iter==1,]$Package, file, row.names = FALSE, col.names = FALSE, quote = FALSE)