#' Install & load CRAN, GitHub, and GitLab packages as current on given date
#'
#' Load requested package(s) as current on a requested date. If the needed version
#' of a package, or its dependencies, is not already installed, groundhog automatically
#' installs it. `groundhog.library()` thus substitutes both `library()`
#' and `install.packages()`. There is no change in setup or configuration parameters
#' needed to start using groundhog; simply edit your script going between
#' `library()` and `groundhog.library()` as needed. Groundhog often installs/uninstalls
#' packages in the default personal library. These changes can be reversed in a few seconds,
#' with [`restore.library()`]
#'
#'@param pkg character string or vector with name of package(s) to load/install.
#'@param date character string (yyyy-mm-dd), or date value, with the date which
#'determines the version of the package, and all dependencies, to be loaded
#'(and installed if needed). The most recent date accepted is 2 days prior
#'to when the code is executed.
#'@param quiet.install logical, defaults to `TRUE`. When set to `FALSE`, displays
#'output generated by `install.packages()` when installing from source
#'@param include.suggests logical, defaults to `FALSE`. When set to `TRUE`,
#'loads dependencies classified in the DESCRIPTION file as `suggested`.
#'@param ignore.deps an optional character vector containing dependencies which
#'are already loaded in the R session, and create a conflict with a needed
#'dependency for the package being loaded (mismatch of version), but which should be ignored
#'and groundhog.library() should proceed tolerating the conflict.
#'@param force.source logical (defaults to `FALSE`). When set to `TRUE`, if the requested package,
#'or its dependencies, needs to be installed, they will be installed from source
#'(much slower than from binaries).
#'@param force.source.main logical (defaults to `FALSE`). When set to `TRUE`, if the
#'requested package needs to be installed it will be installed from source
#'(but dependencies are installed from binaries if needed and available).
#'@param force.install logical (defaults to `FALSE`). When set to `TRUE`,
#'will re-install the requested packages and
#'their dependencies even if they are already installed.
#'@param force.install.main logical (defaults to `FALSE`). When set to `TRUE`,
#'will re-install the requested packages even
#'if they are already installed (but dependencies will not be re-installed).
#'@param tolerate.R.version optional character string containing an R version
#' which `groundhog.library()` will not throw an error for using, even if the
#' date entered corresponds to a more recent major R release.
#'@param cores Integer. The maximum number of cores to use during parallel installation
#' of source packages. The default, -1, uses the total number of cores available minus 1.
#' Setting `core`=1 leads to installing source packages, and also to downloading binaries,
#' sequentially. When installation fails, you may want to try cores=1
#'
#'@examples
#'\dontrun{
#' groundhog.library("magrittr", "2022-04-15")
#'
#' pkgs <- c('pwr','metafor')
#' groundhog.library(pkgs, "2022-04-15")
#'
#'# When running an existing script that relied on `library()` to load packages,
#'# you can wrap the library calls in double-quotes, loading the packages with
#'# groundhog:
#'
#' groundhog.library(
#' "
#' library('pwr')
#' library('metafor')
#' library('tidyr')
#' library('rio')
#' library('this.path')
#' "
#' ,'2022-04-01')
#'
#' #Allow using R 3.6.3 despite entering a date that corresponds to R >=4.0.0
#' groundhog.library('rio', '2022-04-11', tolerate.R.version='3.6.3')
#'
#' }
#'
#' @importFrom utils capture.output
#'
#' @details For more information about groundhog check out [groundhogr.com](https://groundhogr.com)
#' @export
#'
#----------------------------------------------------------------------
#OUTLINE
#1 Preliminaries
#2 Directly attach cached pkgs
#3 Get snowballs for all requested packages
#4 Create libpaths
#5 Check conflict with previously groundhog-loaded packages
#6 Install snowball
#7 localize the snowballs
#8 Check conflict now that it is all installed
#9 Library all pkgs
#10 Verify each snowball, saving snowball .rds if successful k=1
#11 Reminder of copy-method if something was installed.
#----------------------------------------------------------------------
groundhog.library <- function(pkg, date, quiet.install = TRUE,
include.suggests = FALSE, ignore.deps=c(),
force.source = FALSE, force.install = FALSE,
force.source.main = FALSE, force.install.main=FALSE,
tolerate.R.version = "" , cores = -1)
{
#--------------------------------------------------------------
#1 Preliminaries
#1.1 Check if new version of groundhog exists
check.groundhog.version(min.days=1) #Function 42 - utils.R
#1.2 Erase conflicts pkg var
.pkgenv[['conflicts']] <- ''
#1.3 Save default libpaths to change back to them after exiting
if (is.null(.pkgenv[["orig_lib_paths"]])) {
.pkgenv[["orig_lib_paths"]] <- .libPaths()
}
#1.4 pkg & date included
if (missing(pkg) || missing(date)) {
msg=paste0("You must include both a package name and a date in 'groundhog.library()' ")
gstop(msg)
}
date.catch <- try(typeof(date),silent=TRUE)
if (as.character(class(date.catch))=="try-error") {
msg=paste0("The object you entered as date, '" , as.character(substitute(date)) ,"', does not exist.")
gstop(msg) #util #51)
}
#1.5 put package name in quotes if it is not an character object and was not put in quotes
pkg.catch <- try(typeof(pkg),silent=TRUE)
if (as.character(class(pkg.catch))=="try-error" || pkg.catch!='character') {
pkg <- as.character(substitute(pkg))
}
#1.6 Sandwich possible library() commands
pkg <- sandwich.library(pkg) #utils.R function 34
#1.7 Validate arguments entered (Utils.R #46)
validate.groundhog.library(pkg, date, quiet.install, include.suggests ,ignore.deps,
force.source , force.install, force.source.main , force.install.main,
tolerate.R.version ,cores)
#1.8 Early return for pkgs that are ready (non-remotes)
remote <- basename(pkg)!=pkg
n.remote <- sum(remote)
if (n.remote==0 & already.all.attached(pkg , date) ) return(invisible(TRUE))
#already.all.attached.R produced: message1("All requested packages are already attached")
#Note: 1.9 & 1.10 could be done on loading, but, better here : (i) in case the user makes a change, and (ii) avoid writing files without authorization
#1.9 Verify a mirror has been set (utils.R #36)
set.default.mirror()
#1.10 Verify a personal library to save non-groundhog packages has been assigned (Utils.R #37)
verify.personal.library.exists()
#1.11 Reload databases if needed
if (is.null(.pkgenv[["cran.toc"]])) load.cran.toc(update.toc = FALSE)
update_cran.toc_if.needed(date) #This will load.cran.toc() if needed as well
#note: it is redundant to run load.cran.toc first since it is part of update_cran.toc
#but the latter depends on the date, we have not yet checked that date is correct
#1.12 On Exit refresh libpath and cran.toc (cran toc can be modified temporarily by a remote)
on.exit({
#Read cran toc again to undo any changes with remote
if (n.remote>0) .pkgenv[['cran.toc']] <- readRDS(file.path(get.groundhog.folder(),"cran.toc.rds"))
#Return libpath, if it has been set.
if (!is.null(.pkgenv[["orig_lib_paths"]])) {
.libPaths(.pkgenv[["orig_lib_paths"]])
}
})
#1.13 how many cores? (total -1 unless specified away from default of -1)
if (cores == -1) {
cores <- max(parallel::detectCores()-1,1)
}
#1.14 Common messages
f10 <- ifelse(interactive(), "\n(in R Studio run CMD/CTRL-SHFT-F10 to restart R session). ","")
#2 Directly attach packages in Cache and drop from consideration packages already attached
#only for non-remote pkgs
#Make copy of all pkgs requested for final verification to include those attached
pkg_full_request = pkg
if (n.remote==0 & force.install==FALSE & force.install.main==FALSE)
{
#Bracket everything in a try() since failure merely means we will run slightly slower)
direct.install.attempt = try({
#Directly attach
pkg_vrs.already_attached = c()
pkg_vrs.attached_from_cache = c()
#pkgs that are active
.pkgenv[['active']] = active = get.active()
.pkgenv[['attached']] = attached = attached_before = get.attached()
#Read cache
#see cache_functions.R
cache.current = is.cache.current() #TRUE/FALSE is the cache more recent than any installed pkg
cache = read.cache()
#Loop looking for already attached or already cached pkgs
for (pkgk in pkg)
{
#Is it already attached?
#Get pkg_vrs
pkgk_vrs=paste0(pkgk,"_",get.version(pkgk,date))
#ALREADY ATACHED?
#Found it?
if (pkgk_vrs %in% attached$pkg_vrs)
{
#Drop this pkgk
pkg=pkg[pkg != pkgk]
#Add pkg__vrs to those that will be shown as 'aready attached'
pkg.already_attached = c(pkg_vrs.already_attached, pkgk_vrs)
} else {
#CACHE
#If cache's date matches the requested date, and it is current
if (cache$date==date & cache.current==TRUE)
{
if (pkgk %in% cache$pkg)
{
#Attach it
base.library(pkgk, character.only=TRUE)
#Drop this pkgk
pkg = pkg[pkg != pkgk]
#Add to vector with attached.cache
pkg_vrs.attached_from_cache = c(pkg_vrs.attached_from_cache , pkgk_vrs)
} #End if pkg foudn in cache
} #End if cache date matches requested date
} #End else not found already attached
} #End loop over pkgk
#Early return if there are no pkgs left
if (length(pkg)==0) {
attached = get.attached()
for (pkgk in pkg_full_request)
{
pkgk_vrs=paste0(pkgk , "_" , get.version(pkgk,date))
#Message wtih feedback
if (pkgk_vrs %in% attached$pkg_vrs & !pkgk_vrs %in% attached_before$pkg_vrs) message1("Successfully attached '",pkgk_vrs,"'")
if (pkgk_vrs %in% attached$pkg_vrs & pkgk_vrs %in% attached_before$pkg_vrs) message1("Had already attached '",pkgk_vrs,"'")
if (!pkgk_vrs %in% attached$pkg_vrs) message("Failed to attached '",pkgk_vrs,"'")
}
return(invisible(TRUE))
}
}) #Close try() of direct install, so that if anything leading to a faster install fails, we ignore it and move on with slightly slower default.
} #End if n.remote==0; do not do cache with remote pkgs
#3 Get snowballs for all requested packages
#Save snowballs individually as a list and also as a single big snowball.all
#3.1 Non-remote snowball
if (n.remote==0)
{
k <- 0
snowball.list <- list()
for (pkgk in pkg)
{
k <- k+1
snowball.k <- get.snowball(pkgk , date , include.suggests)
#options
#force source
# Do not force remote packages)
if (force.source==TRUE) {
snowball.k$from = ifelse(snowball.k$from %in% c('github','gitlab'),
snowball.k$from ,
'source')
}
#For source main
if (force.source.main==TRUE) snowball.k[snowball.k$pkg==pkg,]$from = 'source'
#force install
if (force.install==TRUE) snowball.k$installed = FALSE
if (force.install.main==TRUE) snowball.k[snowball.k$pkg==pkg,]$installed = FALSE
#ignore deps (drop from snowball to avoid installing (and replacing locally)
#note1: we already checked that they are active, so we know they will be available
#note2: we do not save snowballs generated with ignore.deps so that next time the ignore deps are loaded
# see #10.7 below
if (length(ignore.deps)>0)
{
snowball.k <- snowball.k[!snowball.k$pkg %in% ignore.deps,]
}
#Add to snowball.all
if (k==1) snowball.all <- snowball.k
if (k> 1) snowball.all <- rbind(snowball.all, snowball.k)
#Add to list
snowball.list[[k]] <- snowball.k
} #End loop over pkgs
} #End of non-remote
#3.2 Remote snowball (always only 1 to avoid conflicts between dependencies)
if (n.remote==1)
{
#Empty list
snowball.list <- list()
# Process pkg-->usr, remote_id
pkg_list<-make.pkg_list(pkg)
usr <- pkg_list$usr
remote_id <- pkg_list$remote_id
pkg <- pkg_list$pkg
git <- pkg_list$remote_id
#3.2.1 Possible early returns if already attached (or conflicting)
#Full identifier of pkg called: remote, usr, pkg, date. ('GitHub::crsh/papaja_2021_10-01')
git_usr_pkg_date <- paste0(remote_id , "_", usr, "_", pkg ,"_", gsub("-","_",date))
#This same pkg_date loaded & attached early return
if (git_usr_pkg_date %in% .pkgenv[['remotes.attached']]) {
message1("The package '", pkg_list$usr_pkg, "', for '",date,"', is already attached.")
exit()
}
#Same remote did not trigger a match before, something must not match, exit
if (pkg %in% .pkgenv[['session.remotes_df']]$pkg)
{
msg=paste0("Another version of '", pkg, "' was previously loaded into your R session.\n",
"To unload all packages restart your R session. ",f10)
gstop(msg) #util #51)
}
#Stop if they specify "@"
if (regexpr('@', pkg)>0)
{
msg=paste0("Seems like you are specifying a version of the package on the remote repository with '@'.",
"With groundhog.library() you may only access the default version of a Git package. Please, ",
"remove the '@' from the package name")
message(msg)
exit()
}
#Get snowball
snowball.all <- get.snowball.remote(pkg,date,remote_id, usr,include.suggests,force.install=force.install)
#Force source: Set from to source for non-remote packages
if (force.source == TRUE) snowball.all$from[is.na(snowball.all$sha)] <- 'source'
#list
snowball.list[[1]] <- snowball.all
}
#------------------------------------------------------------
#4 Create libpaths
#4.1 Create paths of packages we will install, so that they can be added to libpath
for (j in 1:nrow(snowball.all))
{
if (snowball.all$installed[j]==FALSE) dir.create(snowball.all$installation.path[j],recursive = TRUE, showWarnings = FALSE)
}
#4.2 Set libpaths for big snowball
new_paths<-snowball.all$installation.path[snowball.all$installed==FALSE]
# new_paths<-snowball.all$installation.path
.libPaths(c(unique(new_paths), .pkgenv[["orig_lib_paths"]]))
#5 Check conflict with previously groundhog-loaded packages
#Get currently active packages
check.conflict.before(snowball=snowball.all, pkg.requested=pkg, ignore.deps, date) #check.snowball.conflict.R
#6 Install snowball
#6.1 Do we need to install on background?
# Any source package that needs install is loaded and thus needs background install?
snowball.install.source <- snowball.all[snowball.all$from=='source' & snowball.all$installed==FALSE,]
n.source.conflict <- sum(snowball.install.source$pkg %in% .pkgenv[['active']]$pkg)
#6.2 BACKGROUND Install
if (n.source.conflict > 0)
{
pkg_conflict <- snowball.install.source$pkg[snowball.install.source$pkg %in% .pkgenv[['active']]$pkg]
msg <- paste0("Some of the package you need to install from source have other versions already loaded in this ",
"R session. You will need to restart the R session to unload them and try again. If the problem ",
"persists it is likely that they are being automatically loaded before your `groundhog.library()` call ",
"(e.g., R Studio automatically loads pkgs referenced in a script when simply opening the script even if you don't execute anything). ",
"You can bypass this automatic loading by (i) cleaning the environment, and (ii) creating an empty ",
"script just with the groundhog library call. Restart the session, execute that code, then switch back ",
"to the script you are working on. You can also look into the `ignore.deps` optional argument in `groundhog.library`.",
"The packages creating the conflict are:-> ",
pasteQC(pkg_conflict)
)
gstop(format_msg(msg))
} #End n conflict>0
#6.3 FOREGROUND INSTALL
if (n.source.conflict == 0) {
install.snowball(snowball.all,date, cores)
}
#------------------------------------------------------------------------
#7 localize the snowballs
#Drop base pkgs from snowball.all
snowball.all<-snowball.all [!snowball.all$pkg %in% base_pkg(),]
#localize
localize.snowball(snowball.all)
#localizing means copying the folder of the installed package to the default (non-groundhog) folder
#------------------------------------------------------------------------
#8 Check conflict now that it is all installed (will prompt a restart if a conflict exists, will not occur again because they are localized)
check.conflict.after(snowball.all, pkg.requested=pkg ,ignore.deps=ignore.deps, date=date)
#------------------------------------------------------------------------
#9 Library all pkgs
#9.1 - Return to libpath and load pkgs
.libPaths(.pkgenv[["orig_lib_paths"]])
#9.2 #verify pkg is indeed available in local
ip.local<-get.ip('local')
for (pkgk in pkg)
{
if (!pkgk %in% c(ip.local$Package, base_pkg())) {
#Ask to run again if we have not asked in the last 5 minutes
cookie <-'pkgk_not_in_iplocal'
minutes <- get.minutes.since.cookie(cookie)
if (minutes>5)
{
msg <- paste0("Failed in attempt to load ",pkgk,". \n",
"You may want to try again running `groundhog.library()` and only if it fails again troubleshoot deeper.")
save.cookie(cookie)
}
#Add dropbox msg
if (regexpr('dropbox', tolower(get.groundhog.folder()))>0) {
msg <-paste0(msg,"\nThis issue is likely caused because the groundhog folder is in Dropbox\n",
"You can change its location with `set.groundhog.folder()`")
} #End if dropbox
#Show message that we failed
gstop(msg)
} #End if pkgk not found
} #End loop
#9.3 library()
for (pkgk in pkg) {
base.library(pkgk, character.only=TRUE)
}
#--------------------------------------------------------------------
#10 Verify each snowball, saving snowball .rds if successful k=1
for (k in 1:length(snowball.list))
{
#10.1 Take one snowball
snowball<-snowball.list[[k]]
#10.2 Verified: TRUE or FALSE?
verified <- verify.snowball.loaded(snowball, ignore.deps)
#10.2.5 Add msg to those that were attached via cache or were already attached
#10.3 IF VERIFIED
if (verified==TRUE) {
#10.3.5 Add entire snowball to cache
add.cache(snowball$pkg , date)
#10.4 Path for CRAN snowball
if (!'sha' %in% names(snowball))
{
#dir
snowball_dir <- paste0(get.groundhog.folder() , '/snowballs_v2' )
#file
if (include.suggests==FALSE) snowball_file <- paste0(pkg , "_" , gsub( "-", "_" , date) , '.rds')
if (include.suggests==TRUE) snowball_file <- paste0(pkg , "_" , gsub( "-", "_" , date) , '_with_suggests.rds')
#path
snowball_path <- file.path(snowball_dir, snowball_file)
} else {
#10.5 Path for Remote snowball
#dir
snowball_dir <- paste0(get.groundhog.folder() , '/snowballs_v2/' , remote_id )
#FILE
if (include.suggests==FALSE) snowball_file <- paste0(usr ,"_", pkg , "_" , gsub( "-", "_" , date) , '.rds')
if (include.suggests==TRUE) snowball_file <- paste0(usr ,"_", pkg , "_" , gsub( "-", "_" , date) , '_with_suggests.rds')
#FULL PATH
snowball_path <- file.path(snowball_dir, snowball_file)
}#End 10.5
#10.6 Save snowball
#Update column `installed` in snowball based on what's available
ip.path <- get.ip('groundhog')$LibPath
loans.path<- as.character(get.loans()$groundhog_location)
snowball$installed <- (snowball$installation.path %in% c(ip.path , loans.path) | #if the path we want exists or is in borrowed set
snowball$pkg %in% .pkgenv[['base_pkg']]) #if in packages or in base.packages
#10.7 Save snowball RDS (unless they did ignore.deps for that drops dependencies)
if (length(ignore.deps)==0) {
saveRDS(snowball, snowball_path[k], version = 2, compress=FALSE)
}
#10.8 Add snowball to session
add.session.snowballs(snowball) #utils.R - function #41
#includes variables pkg, vrs, pkg_vrs, repos, requested, sha
#10.9 Add to remotes_df
if (n.remote>0) {
#Add attached remote to session variable so that we can quickly say "already attached"
.pkgenv[['remotes.attached']] <- c(.pkgenv[['remotes.attached']], git_usr_pkg_date )
#Add all remotes to remotes.df
snowball.remotes <- snowball[!is.na(snowball$sha), ]
for (k in 1:nrow(snowball.remotes)) {
rdf_row <- get.remote_df.from.path(snowball.remotes$installation.path)
rdf_row$date <- date
.pkgenv[['session.remotes_df']] <- rbind (.pkgenv[['session.remotes_df']], rdf_row)
} #End loop
} #End if n.remote>0
#10.10 Add groundhog.day to hogdays to alert of possible different days used in a snowball.conflict
if (!is.null(.pkgenv[['hogdays']])) {
.pkgenv[['hogdays']] <- unique(c(date, .pkgenv[['hogdays']]))
} else {
.pkgenv[['hogdays']]<- date
} #End if 10.10
} #End if (verified==TRUE)
}#End of #10
#10.12 Add feedback on pkgs that were previously directly attached
attached = get.attached()
#What packages were attached directly? (only for non-remotes we use cache so skip for others)
if (n.remote==0 & force.install==FALSE & force.install.main==FALSE)
{
pkg_direct = pkg_full_request[!pkg_full_request %in% pkg]
#Loop over them
for (pkgk in pkg_direct)
{
pkgk_vrs = paste0(pkgk,"_",get.version(pkgk,date))
#Message with installation feedback
if (pkgk_vrs %in% attached$pkg_vrs & !pkgk_vrs %in% attached_before$pkg_vrs) message1("Successfully attached '",pkgk_vrs,"'")
if (pkgk_vrs %in% attached$pkg_vrs & pkgk_vrs %in% attached_before$pkg_vrs) message1( "Had already attached '",pkgk_vrs,"'")
if (!pkgk_vrs %in% attached$pkg_vrs) message("10.12 Failed to attached '",pkgk_vrs,"'")
}
}
#----------------------------------
#11 Reminder of copy-method if something was installed.
if (sum(snowball.all$installed==FALSE)>0)
{
#1) DROPBOX
if (groundhog.in.dropbox()==TRUE & cookie.exists("copy_instead_of_renaming")) {
#If msg shown more than 10 minutes ago
if (get.minutes.since.cookie('copy_method_and_dropbox') > 24*60*60)
{
#Save cookie
save.cookie('copy_method_and_dropbox')
#Show message
msg=paste0("Having groundhog folder in Dropbox makes things slower. ",
"You can use `set.groundhog.folder(<path>)` to change its location. ",
"You can also run `try.renaming.method.again()` to continue using the ",
"dropbox folder but give another try to the faster package-copying ",
"method which *occassionally* does not work with Dropbox folders. ",
"This message will not be shown again today.")
message(format_msg(msg,header='Reminder: '))
}
}
#2) NO DROPBOX
if (groundhog.in.dropbox()==FALSE & cookie.exists("copy_instead_of_renaming")) {
#If msg shown more than 10 minutes ago
if (get.minutes.since.cookie('copy_method_WITHOUT_dropbox') > 24*60*60)
{
#Save cookie
save.cookie('copy_method_WITHOUT_dropbox')
#Show message
msg=paste0("Groundhog could run faster than is currently running. ",
"Check out how with `help('try.renaming.method.again')` ",
"This message will not be shown again today.")
message(format_msg(msg,header='NOTE: '))
} #ENd if cookie is old
} #End if using copy method without dropbox
}
} #End new.groundhog.folder()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.