-
Notifications
You must be signed in to change notification settings - Fork 3
/
needs.R
85 lines (84 loc) · 2.97 KB
/
needs.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
tryCatch(needs(), error = function(e) {
while (".needs" %in% search()) detach(.needs)
.needs <- new.env(parent = .GlobalEnv)
.needs$needs <- function(...)
{
needs_ <- function(...) {
pkgs <- unlist(...)
if (length(pkgs)) {
loaded <- suppressWarnings(suppressMessages(sapply(pkgs,
library, character = T, logical = T)))
if (any(!loaded)) {
missing <- pkgs[!loaded]
cat("installing packages:n")
cat(missing, sep = "n")
utils::install.packages(missing, repos = "http://cran.rstudio.com/",
quiet = T)
}
suppressWarnings(suppressMessages(sapply(pkgs, library,
character = T)))
}
}
packageInfo <- utils::installed.packages()
if (!missing(...)) {
pkgs <- as.list(substitute(list(...)))[-1]
parsed <- if (is.null(names(pkgs))) {
as.character(pkgs)
}
else {
mapply(paste, names(pkgs), as.character(pkgs), MoreArgs = list(sep = ":"))
}
parts <- lapply(strsplit(parsed, "[:=(, ]+"), function(d) {
d[d != ""]
})
grouped <- split(parts, sapply(parts, length))
needs_(grouped$`1`)
toCheck <- grouped$`2`
if (length(toCheck)) {
installedPackages <- packageInfo[, "Package"]
needsPackage <- sapply(toCheck, `[`, 1)
needsVersion <- sapply(toCheck, function(x) {
gsub("[^0-9.-]+", "", x[2])
})
installed <- needsPackage %in% installedPackages
needs_(needsPackage[!installed])
compared <- mapply(utils::compareVersion, needsVersion[installed],
packageInfo[needsPackage[installed], "Version"])
if (any(compared == 1)) {
toUpdate <- needsPackage[installed][compared ==
1]
cat("updating packages:n")
cat(toUpdate, sep = "n")
utils::update.packages(oldPkgs = toUpdate, ask = F)
}
needs_(needsPackage[installed])
}
}
if (.printConflicts) {
s <- search()
conflict <- conflicts(detail = T)
conflict[names(conflict) %in% c("package:base", "Autoloads",
".GlobalEnv")] <- NULL
tab <- table(unlist(sapply(conflict, unique)))
fxns <- names(tab[tab > 1])
where <- sapply(fxns, function(f) {
i <- 1
while (!length(ls(pos = i, pattern = sprintf("^%s$",
f)))) {
i <- i + 1
if (i > length(s))
break
}
s[i]
})
if (length(where)) {
df <- data.frame(FUNCTION = names(where), LOCATION = paste0(" ",
where[order(names(where))]), stringsAsFactors = F)
print(df, row.names = F)
}
}
invisible()
}
# attach to the search path
attach(.needs)
})