2 r_bundle_of <- function(pkgname) {
3 return(NULL) ## there are no more bundles as of R 2.11.0
5 ## -- old code below, never reached
7 # returns the bundle containing pkgname or NA
8 bundles <- names(available[!is.na(available[, 'Bundle']), 'Contains'])
10 for (bundle in bundles) {
11 if (pkgname %in% r_bundle_contains(bundle)) {
18 r_bundle_contains <- function(bundlename) {
19 return(strsplit(available[bundlename,'Contains'],'[[:space:]]+')[[1]])
22 r_requiring <- function(names) {
24 if (!(name %in% base_pkgs) && !(name %in% rownames(available))) {
25 bundle <- r_bundle_of(name)
26 if (!is.null(bundle)) {
28 names <- c(names,bundle)
31 if (name %in% rownames(available) && !is.na(available[name,'Contains'])) {
32 names <- c(names,r_bundle_contains(name))
35 # approximately prune first into a smaller availability
36 candidates <- rownames(available)[sapply(rownames(available)
38 length(grep(paste(names,collapse='|')
39 ,available[name,r_depend_fields])) > 0)]
40 if (length(candidates) == 0) {
43 # find a logical index into available of every package/bundle
44 # whose dependency field contains at least one element of names.
45 # (this is not particularly easy to read---sorry---but is much faster than
46 # the alternatives i could think of)
48 dep_matches <- function(dep) chomp(gsub('\\([^\\)]+\\)','',dep)) %in% names
49 any_dep_matches <- function(name,field=NA)
50 any(sapply(strsplit(chomp(available[name,field])
51 ,'[[:space:]]*,[[:space:]]*')
54 for (field in r_depend_fields) {
55 matches = sapply(candidates, any_dep_matches, field=field)
56 if (length(matches) > 0) {
57 prereq = c(prereq,candidates[matches])
60 return(unique(prereq))
63 r_dependencies_of <- function(name=NULL,description=NULL) {
64 # find the immediate dependencies (children in the dependency graph) of an
66 if (!is.null(name) && (name == 'R' || name %in% base_pkgs)) {
69 if (is.null(description) && is.null(name)) {
70 fail('must specify either a description or a name.')
72 if (is.null(description)) {
73 if (!(name %in% rownames(available))) {
74 bundle <- r_bundle_of(name)
75 if (!is.null(bundle)) {
78 # unavailable packages don't depend upon anything
82 description <- data.frame()
83 # keep only the interesting fields
84 for (field in r_depend_fields) {
85 if (!(field %in% names(available[name,]))) {
88 description[1,field] = available[name,field]
91 # extract the dependencies from the description
93 for (field in r_depend_fields) {
94 if (!(field %in% names(description[1,]))) {
97 new_deps <- lapply(strsplit(chomp(description[1,field])
98 ,'[[:space:]]*,[[:space:]]*')[[1]]
100 deps <- iterate(lapply(new_deps[!is.na(new_deps)],rbind),deps,rbind)
105 r_parse_dep_field <- function(dep) {
109 # remove other comments
110 dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep)
112 dep = chomp(gsub('[[:space:]]+',' ',dep))
114 pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$'
115 if (!length(grep(pat,dep))) {
116 fail('R dependency',dep,'does not appear to be well-formed')
118 version = sub(pat,'\\3',dep)
119 dep = sub(pat,'\\1',dep)
120 if (!(dep %in% rownames(available))) {
121 depb <- r_bundle_of(dep)
122 if (!is.null(depb)) {
126 return(list(name=dep,version=version))
129 r_dependency_closure <- function(fringe, forward_arcs=T) {
130 # find the transitive closure of the dependencies/prerequisites of some R
133 if (is.data.frame(fringe)) {
134 fringe <- as.list(fringe$name)
136 fun = function(x) r_dependencies_of(name=x)$name
140 while(length(fringe) > 0) {
143 if (length(fringe) > 1) {
144 fringe <- fringe[2:length(fringe)]
148 src <- pkgname_as_debian(top,binary=F)
153 closure=c(closure,top)
154 fringe=c(fringe,newdeps)
157 return(rev(unique(closure,fromLast=T)))