From 3283f550cdb52bdff9077fe1e4a0de6975e85f68 Mon Sep 17 00:00:00 2001 From: Renaud Date: Thu, 5 Mar 2015 14:49:01 +0200 Subject: [PATCH 1/7] isPathFromRoot: added support to home directory '~' shortcut --- R/filenames.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/filenames.R b/R/filenames.R index 6c11b51..b2ad1ae 100644 --- a/R/filenames.R +++ b/R/filenames.R @@ -110,7 +110,7 @@ removeDirs = function(paths, recursive=FALSE, ..., mustWork=TRUE, maxTries=30L, } isPathFromRoot = function(path) { - (isWindows() & grepl("^[[:alpha:]]:", path)) | grepl("^[/\\]", path) + (isWindows() & grepl("^[[:alpha:]]:", path)) | grepl("^[~/\\]", path) } getJobDirs = function(reg, ids, unique = FALSE) { From 0d621bdac6e0d5f4c21eaad54af6fcb22d7dc2dc Mon Sep 17 00:00:00 2001 From: Renaud Date: Thu, 5 Mar 2015 15:03:58 +0200 Subject: [PATCH 2/7] Implement loading source packages in argument 'src.dirs' --- R/sourceRegistryFiles.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/R/sourceRegistryFiles.R b/R/sourceRegistryFiles.R index 6228661..071d19d 100644 --- a/R/sourceRegistryFiles.R +++ b/R/sourceRegistryFiles.R @@ -29,6 +29,23 @@ sourceRegistryFilesInternal = function(work.dir, dirs, files, envir = .GlobalEnv if (length(w)) stopf("Directories to source not found, e.g. %s", dirs[w]) + # detect source package directories + wpkg <- which(sapply(file.path(dirs, 'DESCRIPTION'), file.exists)) + if( length(wpkg) ){ + # setup temporary directory to hold package loading script + tmpdir <- tempfile('BatchJobs_load_all_') + dir.create(tmpdir) + on.exit( unlink(tmpdir, recursive = TRUE) ) + # generate loading scripts + lapply(dirs[wpkg], function(d){ + cat(sprintf("# load source package\ndevtools::load_all('%s', reset = TRUE)\n", d) + , file = tempfile(paste0(basename(d), '_'), tmpdir, fileext = ".R")) + }) + # remove directory from list and add temporary load_all directory + dirs <- c(dirs[-wpkg], tmpdir) + } + ## + lapply(c(getRScripts(dirs), files), sys.source, envir = envir) invisible(TRUE) } From e7c425d5c502c08b28b8a75bef1450fc4c2cd1a3 Mon Sep 17 00:00:00 2001 From: Renaud Date: Thu, 5 Mar 2015 16:21:52 +0200 Subject: [PATCH 3/7] fixed bug when empty source directory --- R/sourceRegistryFiles.R | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/R/sourceRegistryFiles.R b/R/sourceRegistryFiles.R index 071d19d..acd9aea 100644 --- a/R/sourceRegistryFiles.R +++ b/R/sourceRegistryFiles.R @@ -30,19 +30,21 @@ sourceRegistryFilesInternal = function(work.dir, dirs, files, envir = .GlobalEnv stopf("Directories to source not found, e.g. %s", dirs[w]) # detect source package directories - wpkg <- which(sapply(file.path(dirs, 'DESCRIPTION'), file.exists)) - if( length(wpkg) ){ - # setup temporary directory to hold package loading script - tmpdir <- tempfile('BatchJobs_load_all_') - dir.create(tmpdir) - on.exit( unlink(tmpdir, recursive = TRUE) ) - # generate loading scripts - lapply(dirs[wpkg], function(d){ - cat(sprintf("# load source package\ndevtools::load_all('%s', reset = TRUE)\n", d) - , file = tempfile(paste0(basename(d), '_'), tmpdir, fileext = ".R")) - }) - # remove directory from list and add temporary load_all directory - dirs <- c(dirs[-wpkg], tmpdir) + if( length(dirs) ){ + wpkg <- which(sapply(file.path(dirs, 'DESCRIPTION'), file.exists)) + if( length(wpkg) ){ + # setup temporary directory to hold package loading script + tmpdir <- tempfile('BatchJobs_load_all_') + dir.create(tmpdir) + on.exit( unlink(tmpdir, recursive = TRUE) ) + # generate loading scripts + lapply(dirs[wpkg], function(d){ + cat(sprintf("# load source package\ndevtools::load_all('%s', reset = TRUE)\n", d) + , file = tempfile(paste0(basename(d), '_'), tmpdir, fileext = ".R")) + }) + # remove directory from list and add temporary load_all directory + dirs <- c(dirs[-wpkg], tmpdir) + } } ## From 8ac70bc08229480d3eb863cc94ec7fbafccbaf15 Mon Sep 17 00:00:00 2001 From: Renaud Date: Thu, 5 Mar 2015 16:30:41 +0200 Subject: [PATCH 4/7] Implement loading source packages in argument 'src.packages' --- DESCRIPTION | 3 ++- R/Registry.R | 26 +++++++++++++++++++++++--- 2 files changed, 25 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 52669d8..bc4ef85 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,7 +30,8 @@ Imports: utils Suggests: MASS, - testthat + testthat, + devtools LazyData: yes ByteCompile: yes Version: 1.6 diff --git a/R/Registry.R b/R/Registry.R index 4df03d5..c5f8749 100644 --- a/R/Registry.R +++ b/R/Registry.R @@ -1,3 +1,19 @@ +# internal overloading wrapper for BBmisc::requirePackages +requirePackages <- function(pkg, ...){ + + sapply(pkg, function(pkgname, ...){ + # pre-load source packages + if( grepl("^[~./\\]", pkgname) ){ + a <- devtools::load_all(pkgname, reset = FALSE) # reset = FALSE is very important + pkgname <- packageName(a$env) + } + # standard require + BBmisc::requirePackages(pkgname, ...) + pkgname + }, ...) + +} + makeRegistryInternal = function(id, file.dir, sharding, work.dir, multiple.result.files, seed, packages, src.dirs, src.files) { @@ -20,7 +36,7 @@ makeRegistryInternal = function(id, file.dir, sharding, work.dir, assertCharacter(packages, any.missing = FALSE) packages = union(packages, "BatchJobs") - requirePackages(packages, stop = TRUE, suppress.warnings = TRUE, default.method = "attach") + packages <- requirePackages(packages, stop = TRUE, suppress.warnings = TRUE, default.method = "attach") assertCharacter(src.dirs, any.missing = FALSE) src.dirs = sanitizePath(src.dirs, make.absolute = FALSE) @@ -42,7 +58,7 @@ makeRegistryInternal = function(id, file.dir, sharding, work.dir, checkDir(getExportDir(file.dir), create = TRUE, check.empty = TRUE) sourceRegistryFilesInternal(work.dir, src.dirs, src.files) - packages = setNames(lapply(packages, function(pkg) list(version = packageVersion(pkg))), packages) + packages = setNames(lapply(packages, function(pkg) list(version = packageVersion(pkg))), names(packages)) setClasses(list( id = id, @@ -95,13 +111,17 @@ makeRegistryInternal = function(id, file.dir, sharding, work.dir, #' Default is a random number from 1 to \code{.Machine$integer.max/2}. #' @param packages [\code{character}]\cr #' Packages that will always be loaded on each node. +#' Path to source package directories may also be specified (strings starting with +#' a \code{.}, \code{/} , \code{~} or \code{\\} are considered package directory specifications). #' Default is \code{character(0)}. #' @param src.dirs [\code{character}]\cr -#' Directories containing R scripts +#' Directories containing R scripts or source packages #' to be sourced on registry load (both on slave and master). #' Files not matching the pattern \dQuote{\\.[Rr]$} are ignored. #' Useful if you have many helper functions that are needed during the execution of your jobs. #' These files should only contain function definitions and no executable code. +#' Source package directory must contain a valid DESCRIPTION file and are loaded with +#' \code{\link[devtools]{load_all}}. #' Default is \code{character(0)}. #' @param src.files [\code{character}]\cr #' R scripts files From b4018a26a52c70e28e5703304ca0420e4803e6da Mon Sep 17 00:00:00 2001 From: Renaud Date: Fri, 6 Mar 2015 14:04:40 +0200 Subject: [PATCH 5/7] addRegistryPackages: added packages are now loaded, to force loading source packages --- R/Packages.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/Packages.R b/R/Packages.R index 9908ee9..10df091 100644 --- a/R/Packages.R +++ b/R/Packages.R @@ -12,7 +12,9 @@ addRegistryPackages = function(reg, packages) { checkRegistry(reg) assertCharacter(packages, any.missing = FALSE) - packages = setNames(lapply(packages, function(pkg) list(version = packageVersion(pkg))), packages) + # load packages (this forces source packages to be loaded) + packages <- requirePackages(packages, stop = TRUE, suppress.warnings = TRUE, default.method = "attach") + packages = setNames(lapply(packages, function(pkg) list(version = packageVersion(pkg))), names(packages)) p = c(reg$packages, packages) p = p[unique(names(p))] reg$packages = p From eef21ee7a14596ba6d371f7302fb6aded2db8ad3 Mon Sep 17 00:00:00 2001 From: Renaud Date: Fri, 6 Mar 2015 14:17:45 +0200 Subject: [PATCH 6/7] Reverted change in isPathFromRoot because it broke sanitizePath. Now directly check for '~' in sourceRegistryFilesInternal --- R/filenames.R | 2 +- R/sourceRegistryFiles.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/filenames.R b/R/filenames.R index b2ad1ae..6c11b51 100644 --- a/R/filenames.R +++ b/R/filenames.R @@ -110,7 +110,7 @@ removeDirs = function(paths, recursive=FALSE, ..., mustWork=TRUE, maxTries=30L, } isPathFromRoot = function(path) { - (isWindows() & grepl("^[[:alpha:]]:", path)) | grepl("^[~/\\]", path) + (isWindows() & grepl("^[[:alpha:]]:", path)) | grepl("^[/\\]", path) } getJobDirs = function(reg, ids, unique = FALSE) { diff --git a/R/sourceRegistryFiles.R b/R/sourceRegistryFiles.R index acd9aea..9938026 100644 --- a/R/sourceRegistryFiles.R +++ b/R/sourceRegistryFiles.R @@ -23,7 +23,7 @@ sourceRegistryFilesInternal = function(work.dir, dirs, files, envir = .GlobalEnv if (length(w)) stopf("Files to source not found, e.g. %s", files[w]) - w = !isPathFromRoot(dirs) + w = !isPathFromRoot(dirs) && !grepl("^~", dirs) dirs[w] = file.path(work.dir, dirs[w]) w = which.first(!isDirectory(dirs)) if (length(w)) From 7a71af8a342d542e964d1d4583cc72b7f9244a42 Mon Sep 17 00:00:00 2001 From: Renaud Date: Fri, 6 Mar 2015 14:21:55 +0200 Subject: [PATCH 7/7] Fixed typo in checking '~' prefix in sourceRegistryFilesInternal --- R/sourceRegistryFiles.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/sourceRegistryFiles.R b/R/sourceRegistryFiles.R index 9938026..1a0120c 100644 --- a/R/sourceRegistryFiles.R +++ b/R/sourceRegistryFiles.R @@ -23,7 +23,7 @@ sourceRegistryFilesInternal = function(work.dir, dirs, files, envir = .GlobalEnv if (length(w)) stopf("Files to source not found, e.g. %s", files[w]) - w = !isPathFromRoot(dirs) && !grepl("^~", dirs) + w = !isPathFromRoot(dirs) & !grepl("^~", dirs) dirs[w] = file.path(work.dir, dirs[w]) w = which.first(!isDirectory(dirs)) if (length(w))