Skip to content

Instantly share code, notes, and snippets.

@statguy
Last active August 29, 2015 13:56
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save statguy/9024152 to your computer and use it in GitHub Desktop.
Save statguy/9024152 to your computer and use it in GitHub Desktop.
givemeINLA-testing.R patched for downgrading R-INLA
`inla.update` = function(lib = NULL, testing = FALSE, force = FALSE, build.epoch=NULL, build.date=NULL)
{
inla.installer(lib=lib, testing=testing, force=force, build.epoch=build.epoch, build.date=build.date)
}
`inla.installer` = function(lib = NULL, testing = FALSE, force = FALSE, build.epoch=NULL, build.date=NULL)
{
## include depends-on packages here
for(p in c("sp", "Matrix", "splines")) {
if (length(grep(paste("^package:", p, "$", sep=""), search())) == 0) {
if (!require(p, quietly = TRUE, lib.loc = lib, character.only=TRUE)) {
install.packages(p)
##stop(paste("INLA need package `", p, "' to be fully functional; please install", sep=""))
}
}
}
if (testing)
www = "http://www.math.ntnu.no/inla/binaries/testing"
else
www = "http://www.math.ntnu.no/inla/binaries"
if (!is.null(build.epoch) | !is.null(build.date)) {
if (is.null(build.epoch) | is.null(build.date))
stop("Please provide build.epoch and build.date arguments.")
if (inla.installer.os("windows")) stop("Sorry, old Windows binaries unavailable.")
www = paste(www, "/Old", sep="")
if (inla.installer.os("windows")) {
suff = ".zip"
tp = "win.binary"
} else {
suff = ".tgz"
tp = "source"
}
dfile = paste(tempdir(), .Platform$file.sep, "INLA", suff, sep="")
sfile = paste(www, "/INLA_0.0-", build.epoch, ".tgz-", build.date, sep="")
download.file(sfile, dfile)
}
else {
b.date = scan(paste(www,"/build.date", sep=""), quiet=TRUE, what = character(0))
if (exists("inla.version")) {
bb.date = inla.version("bdate")
} else {
bb.date = "INLA.is.not.installed"
}
if (b.date == as.character(bb.date)) {
cat("\nYou have the newest version of INLA:\n")
inla.version()
if (!force)
return (invisible())
else
cat("\nForce a new install\n")
}
## download and install INLA
if (inla.installer.os("windows")) {
suff = ".zip"
tp = "win.binary"
} else {
suff = ".tgz"
tp = "source"
}
dfile = paste(tempdir(), .Platform$file.sep, "INLA", suff, sep="")
sfile = paste(www, "/INLA", suff, sep="")
download.file(sfile, dfile)
}
## use previous path if available
if (is.null(lib)) {
lib = searchpaths()[grep("[\\/]INLA$", searchpaths())]
if (length(lib) == 0) {
lib = NULL
} else {
while(length(grep("/?INLA$", lib)))
lib = sub("/?INLA$", "", lib)
}
if (is.null(lib)) {
## ###########################################
## this part is copied from install.packages()
## ###########################################
if (missing(lib) || is.null(lib)) {
lib <- .libPaths()[1L]
if (length(.libPaths()) > 1L)
warning(gettextf("argument 'lib' is missing: using '%s'",
lib), immediate. = TRUE, domain = NA)
}
ok <- file.info(lib)$isdir & (file.access(lib, 2) == 0)
if (length(lib) > 1 && any(!ok))
stop(sprintf(ngettext(sum(!ok), "'lib' element '%s' is not a writable directory",
"'lib' elements '%s' are not writable directories"),
paste(lib[!ok], collapse = ", ")), domain = NA)
if (length(lib) == 1 && inla.installer.os("windows")) {
ok <- file.info(lib)$isdir
if (ok) {
fn <- file.path(lib, "_test_dir_")
unlink(fn, recursive = TRUE)
res <- try(dir.create(fn, showWarnings = FALSE))
if (inherits(res, "try-error") || !res) {
ok <- FALSE
} else {
unlink(fn, recursive = TRUE)
}
}
}
if (length(lib) == 1L && !ok) {
warning(gettextf("'lib = \"%s\"' is not writable", lib),
domain = NA, immediate. = TRUE)
userdir <- unlist(strsplit(Sys.getenv("R_LIBS_USER"),
.Platform$path.sep))[1L]
if (interactive() && !file.exists(userdir)) {
msg <- gettext("Would you like to create a personal library\n'%s'\nto install packages into?")
if (inla.installer.os("windows")) {
ans <- winDialog("yesno", sprintf(msg, userdir))
if (ans != "YES")
stop("unable to install the INLA package")
} else {
ans <- readline(paste(sprintf(msg, userdir),
" (y/n) "))
if (substr(ans, 1L, 1L) == "n")
stop("unable to install the INLA package")
}
if (!dir.create(userdir, recursive = TRUE))
stop("unable to create ", sQuote(userdir))
lib <- userdir
.libPaths(c(userdir, .libPaths()))
} else {
stop("unable to install packages")
}
}
## ###########################################
## end of copy...
## ###########################################
}
} else {
## ###########################################
## same here
## ###########################################
ok <- file.info(lib)$isdir & (file.access(lib, 2) == 0)
if (length(lib) > 1 && any(!ok))
stop(sprintf(ngettext(sum(!ok), "'lib' element '%s' is not a writable directory",
"'lib' elements '%s' are not writable directories"),
paste(lib[!ok], collapse = ", ")), domain = NA)
}
## remove old library before installing the new one
try(detach(package:INLA), silent = TRUE)
try(unloadNamespace("INLA"), silent = TRUE)
install.packages(dfile, lib = lib, repos=NULL, type = tp)
library(INLA, lib.loc = lib)
cat("\nType\n\tinla.version()\nto display the new version of R-INLA. Thanks for upgrading.\n\n")
cat("\n\n\nYou can later upgrade INLA using: inla.upgrade(testing=TRUE)\n")
return (invisible())
}
`inla.installer.os` = function(type = c("linux", "mac", "windows", "else"))
{
if (missing(type)) {
stop("Type of OS is required.")
}
type = match.arg(type)
if (type == "windows") {
return (.Platform$OS.type == "windows")
} else if (type == "mac") {
result = (file.info("/Library")$isdir && file.info("/Applications")$isdir)
if (is.na(result)) {
result = FALSE
}
return (result)
} else if (type == "linux") {
return ((.Platform$OS.type == "unix") && !inla.installer.os("mac"))
} else if (type == "else") {
return (TRUE)
} else {
stop("This shouldn't happen.")
}
}
`inla.installer.os.type` = function()
{
for (os in c("windows", "mac", "linux", "else")) {
if (inla.installer.os(os)) {
return (os)
}
}
stop("This shouldn't happen.")
}
`inla.installer.os.32or64bit` = function()
{
return (ifelse(.Machine$sizeof.pointer == 4, "32", "64"))
}
`inla.installer.os.is.32bit` = function()
{
return (inla.installer.os.32or64bit() == "32")
}
`inla.installer.os.is.64bit` = function()
{
return (inla.installer.os.32or64bit() == "64")
}
`givemeINLA` = function(...) inla.installer(...)
if (!exists("inla.lib")) inla.lib = NULL
@statguy
Copy link
Author

statguy commented Feb 15, 2014

Example usage:

library(devtools)
source_gist("9024152")
givemeINLA(testing=TRUE, lib=inla.lib, build.epoch=1392038322, build.date=201402101418)

Old versions can be found here.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment