Commit d09afbd5 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer
Browse files

Re-write mortalityTables.(load|list) to prevent timouts when listing installed packages

Rather than using installed.packages() and then loop through all packages and check whether they match ^MoratalityTables$, directly access the library directory structure on disk and list all matching package directories. Problem with installed.packages() is that it does not simply list all existing package directories, but loads all different kinds of other stuff, so try not to use it.
parent 76af12a8
Package: MortalityTables
Type: Package
Version: 2.0.1
Date: 2020-08-27
Date: 2020-09-07
Title: A Framework for Various Types of Mortality / Life Tables
Authors@R: c(person("Reinhold", "Kainhofer", role=c("aut", "cre"), email="reinhold@kainhofer.com"))
Author: Reinhold Kainhofer [aut, cre]
......@@ -11,11 +11,12 @@ BugReports: https://gitlab.open-tools.net/R/r-mortality-tables/-/issues
Encoding: UTF-8
Depends:
ggplot2,
R (>= 2.10)
Imports:
methods,
scales,
utils,
pracma,
R (>= 2.10)
pracma
Suggests:
lifecontingencies,
MortalityLaws,
......
......@@ -15,16 +15,22 @@
#'
#' @export
mortalityTables.list = function(pattern = "*", package = c("^MortalityTables", "^PensionTables"), prefix = "MortalityTables") {
ret = c()
pkgs = utils::installed.packages()
for (p in pkgs[,1]) {
if (any(sapply(package, grepl, p))) { # package matches the pattern given as argument
filepath = system.file("extdata", package = p);
files = Sys.glob(file.path(filepath, paste(prefix, "_", pattern, ".R", sep = "")))
ret = c(ret, gsub(paste('^', prefix, '_(.*).R$', sep = ""), '\\1', basename(files)))
}
# TODO: Generalize lib.loc to a function parameter
res = c()
for (p in pattern) {
# We want all files that are of the following form:
# [LIBDIR]/MortalityTables*/extdata/[PREFIX]_[NAME].R and return the list of all [NAME] parts
lib.loc <- .libPaths()
# Get a list of all directories for MortalityTables / PensionTable extensions packages
packs = unlist(lapply(package, FUN = function(p) { list.files(lib.loc, p, full.names = TRUE)}))
# From those directories, list all extdata/[prefix]_[pattern].R files
files = Sys.glob(file.path(packs, "extdata", paste(prefix, "_", pattern, ".R", sep = "")))
# Extract the name, i.e. everything after the prefix and without the .R:
res = c(res, gsub(paste('^', prefix, '_(.*).R$', sep = ""), '\\1', basename(files)))
}
ret
res
}
#' List all available sets of pension tables provided by the \link[MortalityTables]{MortalityTables-package} package
......
......@@ -7,6 +7,8 @@
#' directory. Defaults to all packages starting with names that
#' start with "MortalityTables" or "PensionTables".
#' Multiple packages can be given as a vector, even using regular expressions.
#' This package is not automatically loaded. If a provided
#' dataset needs its proving package loaded, it can do so explicitly.
#' @param prefix The prefix for the data sets (default is "MortalityTables").
#'
#' @examples
......@@ -14,41 +16,47 @@
#' mortalityTables.load("Austria_Annuities_*")
#' mortalityTables.load("Austria_Annuities_AVOe2005R")
#' mortalityTables.load("*Annuities")
#' mortalityTables.load("MyCustomTable", package = c("MyCustomPackage"))
#' \dontrun{mortalityTables.load("MyCustomTable", package = c("MyCustomPackage"))}
#'
#' @export
mortalityTables.load = function(dataset, package = c("^MortalityTables", "^PensionTables"), prefix = "MortalityTables") {
sets = mortalityTables.list(dataset, package = package, prefix = prefix);
if (length(sets) == 0) {
warning(sprintf("Unable to locate dataset '%s' provided by the %s package!", dataset, paste(c(package), collapse = " or ")));
# TODO: Generalize lib.loc to a function parameter
# We want all files that are of the following form:
# [LIBDIR]/MortalityTables*/extdata/[PREFIX]_[NAME].R
# where [NAME] matches the dataset argument and load them
if (missing(dataset)) {
warning("No datasets given to load mortality tables. Please list at least one dataset (or a corresponding pattern)")
}
pkgs = utils::installed.packages()
for (set in sets) {
sname = gsub("[^-A-Za-z0-9_.]", "", set);
message("Loading table dataset '", sname, "'");
loaded = FALSE;
for (p in pkgs[,1]) {
if (any(sapply(package, grepl, p))) { # package matches the pattern given as argument
filename = system.file("extdata", paste(prefix, "_", sname, ".R", sep = ""), package = p);
if (filename != "") {
# Make sure the providing package is loaded, in case it provides helper functions
require(p, character.only = TRUE)
# Taken from the definition of sys.source and adjusted to include the
# encoding (required for Windows, otherwise UTF8-strings will be broken!)
lines = readLines(filename, encoding = "UTF-8", warn = FALSE)
srcfile = srcfilecopy(filename, lines, file.mtime(filename), isFile = TRUE)
exprs = parse(text = lines, srcfile = srcfile, keep.source = TRUE)
for (i in seq_along(exprs))
eval(exprs[i], envir = globalenv())
for (set in dataset) {
lib.loc <- .libPaths()
# Get a list of all directories under lib.loc for MortalityTables / PensionTable extensions packages
packs = unlist(lapply(package, FUN = function(p) { list.files(lib.loc, p, full.names = TRUE)}))
# From those directories, list all extdata/[prefix]_[set].R files
files = Sys.glob(file.path(packs, "extdata", paste(prefix, "_", set, ".R", sep = "")))
if (length(files) == 0) {
warning(sprintf("Unable to locate dataset '%s' provided by the package(s) %s!", dataset, paste(c(package), collapse = " or ")));
}
loaded = FALSE
for(filename in files) {
# Taken from the definition of sys.source and adjusted to include the
# encoding (required for Windows, otherwise UTF8-strings will be broken!)
lines = readLines(filename, encoding = "UTF-8", warn = FALSE)
srcfile = srcfilecopy(filename, lines, file.mtime(filename), isFile = TRUE)
exprs = parse(text = lines, srcfile = srcfile, keep.source = TRUE)
for (i in seq_along(exprs))
eval(exprs[i], envir = globalenv())
# sys.source(filename, envir = globalenv())
loaded = TRUE
# sys.source(filename, envir = globalenv())
loaded = TRUE
}
}
}
if (!loaded) {
warning(sprintf("Unable to locate dataset '%s' provided by the %s package!", sname, package));
warning(sprintf("Unable to locate dataset '%s' provided by the %s package!", set, package));
}
}
}
......
......@@ -16,6 +16,7 @@ Classes to implement and plot cohort life tables
Useful links:
\itemize{
\item \url{https://gitlab.open-tools.net/R/r-mortality-tables}
\item Report bugs at \url{https://gitlab.open-tools.net/R/r-mortality-tables/-/issues}
}
}
......
......@@ -18,7 +18,9 @@ Wildcards (*) are allowed to match and load multiple datasets.}
\item{package}{The package that contains the dataset in its \code{extdata/}
directory. Defaults to all packages starting with names that
start with "MortalityTables" or "PensionTables".
Multiple packages can be given as a vector, even using regular expressions.}
Multiple packages can be given as a vector, even using regular expressions.
This package is not automatically loaded. If a provided
dataset needs its proving package loaded, it can do so explicitly.}
\item{prefix}{The prefix for the data sets (default is "MortalityTables").}
}
......@@ -30,6 +32,6 @@ mortalityTables.list()
mortalityTables.load("Austria_Annuities_*")
mortalityTables.load("Austria_Annuities_AVOe2005R")
mortalityTables.load("*Annuities")
mortalityTables.load("MyCustomTable", package = c("MyCustomPackage"))
\dontrun{mortalityTables.load("MyCustomTable", package = c("MyCustomPackage"))}
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment