R/packages.r

In RLogik/rbettersyntax: Simpler Syntax for R

#' @title load.packages
#' @description Loads packages. If not available, then an install attempt will be carried out.
#' @export load.packages
#'
#' @usage \code{load.packages(mode=STRING, package=STRING/s, url=STRING/s, mirror=INT, force=BOOL, dependencies=BOOL/STRINGS, quietly=BOOL, stop.on.error=BOOL, lib=STRING, file.type=STRING, version=STRING)}
#' @param mode one of \code{'cran'} (Default), \code{'url'}, \code{'github'} or \code{'biocmanager'}. Determines how the package will be loaded. If \code{mode='url'} is set, then there setting the \code{package} vector is optional.
#' @param package a vector of strings.
#' @param url a vector of strings. Either \code{package} or \code{url} should be non-empty.
#' @param mirror an integer between 0 and (currently) 94. If not set, will ask for user input, upon the first time that CRAN-sources are loaded.
#' @param force if set \code{TRUE}, will force an installation. If \code{FALSE} (Default), will first attempt to load the package and then install.
#' @param dependencies either \code{TRUE}, \code{FALSE} or a string-vector. A string-vector is only useful in the case of installing under \code{mode='url'}, and in this one may use either boolean values or a subset of \code{c('Depends', 'Imports', 'LinkingTo', 'Suggests', 'Enhances')}.
#' @param quietly boolean value to control the verbosity of installers.
#' @param stop.on.error a boolean value (default \code{FALSE}). If set as \code{TRUE}, will stop, if loading any package (after attempting to install it) fails.
#' @param lib an optional string, the Git-repository name.
#' @param file.type an optional string, e.g. \code{'zip'} or \code{'gz'}, to be use under \code{mode='url'}, if the downloaded file is to be first unzipped.
#' @param version a string for package versioning. Useful only under \code{mode='biocmanager'}.
#'
#' @examples \dontrun{
#'	load.packages(mirror=53, package='tidyverse', force=TRUE);
#'	load.packages(mirror=53, package=c('tidyverse', 'Matrix'), stop.on.error=TRUE, force=TRUE);
#'	load.packages(mirror=53, package=c('tidyverse', 'Motrix', 'cowplot'), stop.on.error=TRUE, force=TRUE); # this will stop!
#'	load.packages(mode='github', package=c('RLogik/clusterby', 'RLogik/rbettersyntax'), dependencies=TRUE);
#'	load.packages(mode='github', url='https://github.com/RLogik/clusterby/archive/master.zip', file.type='zip', force=TRUE, dependencies=FALSE);
#'
#'	## require('clusterby') will be tried first, then potentially an install, then a require.
#'	load.packages(mode='github', package='clusterby', url='https://github.com/RLogik/clusterby/archive/master.zip', file.type='zip', dependencies=TRUE);
#' };
#'
#' @keywords syntax load install packages

load.packages <- function(
	mode='cran',
	package=c(),
	url=c(),
	mirror=NULL,
	file.type=NULL,
	lib=NULL,
	dependencies=TRUE,
	force=FALSE,
	quietly=FALSE,
	stop.on.error=FALSE,
	version=NULL
) {
	isset_cranmirror <- !is.numeric(mirror) && (base::getOption('repos')[['CRAN']] == '@CRAN@');
	n <- max(length(package), length(url));

	trypackage <- function(pkg, stop.on.error) {
		if(stop.on.error) {
			base::library(pkg, character.only=TRUE);
			return(TRUE);
		} else {
			return(base::require(pkg, character.only=TRUE));
		}
	};

	for(k in c(1:n)) {
		package_ <- package[k];
		url_ <- url[k];
		if(!is.character(package_)) mode <- 'url';

		## versuche ggf. Package zu laden, solange force == FALSE:
		if(!force && is.character(package_)) if(trypackage(package_, FALSE)) next;

		if(mode == 'github') {
			nom <- package_;
			if(is.character(lib)) nom <- paste0(c(lib, nom), collapse='/');
			devtools::install_github(nom, dependencies=dependencies ,force=force);
		} else if(mode == 'url') {
			if(!is.character(url_)) next;
			dep <- dependencies;
			if(is.logical(dependencies)) if(dependencies) dep <- c('Imports', 'Depends');
			bool <- utilsRL::install.from.url(url=url_, file.type=file.type, install=TRUE, require.pkg=TRUE, force=force);
			if(!bool) {
				if(stop.on.error) base::stop(paste0('Package von URL {',url_,'} konnte nicht geladen werden!'));
				base::warning(paste0('Package von URL {',url_,'} konnte nicht geladen werden!'));
			}
			next;
		} else if(mode == 'biocmanager') {
			if(is.null(version)) {
				BiocManager::install(package_, dependencies=dependencies, force=force);
			} else {
				BiocManager::install(package_, dependencies=dependencies, force=force, version=version);
			}
		} else { # if (mode == 'cran') {
			if(!isset_cranmirror) utils::chooseCRANmirror(ind=mirror, graphics=FALSE);
			isset_cranmirror <- TRUE;
			utils::install.packages(package_, dependencies=dependencies, force=force, quietly=quietly);
		}

		## versuche Package zu laden:
		if(!(mode=='url') && trypackage(package_, stop.on.error)) next;
		base::warning('Package ',package_,' konnte nicht geladen werden!');
	}

	return(TRUE);
};




#' @title install.from.url
#' @description Allow for simpler syntax in R. Loads packages from URL, potentially unzipping if necessary. By contrast to \code{installr}, the URLs with parameters do not lead to problems.
#' @export install.from.url
#'
#' @usage \code{install.from.url(pkg.name='...', url='...', file.type='...', install=TRUE/FALSE, require.pkg=TRUE/FALSE, force=TRUE/FALSE)}
#' @param url a character string. A url.
#' @param file.type character. Default \code{NULL}. If not set, then system will attempt to determin whether the file is to be extracted and by what method. If set to \code{'zip'}, \code{'gz'}, \code{'7z'}, etc., then an appropriate method will be applied to unpack the downloaded object.
#' @param install boolean. Default \code{TRUE}. If set to \code{TRUE}, then the package in the downloaded object will be installed, otherwise the path of the downloaded package will be returned.
#' @param pkg.name a character string. Optional. Name of Package, if known. Otherwise, the proceedure extracts this from the downloaded file.
#' @param require.pkg boolean. Default \code{FALSE}. If \code{require.pkg=TRUE} and \code{force=FALSE} and \code{pkg.name} is defined, \code{require(pkg.name)} will be called at the start. If it succeeds, no installation will take place. If \code{require.pkg=TRUE}, then \code{require(···)} will be called at the end.
#' @param force boolean. Defaut \code{FALSE}. If set to \code{FALSE}, determines, whether \code{library(···)} / \code{require(···)} will be attempted first before installation.
#'
#' @examples \dontrun{
#'	install.from.url(url='http://domain.de/mypackage.zip?parameters=areok', file.type='zip');
#'	install.from.url(url='http://domain.de/mypackage.gz?parameters=areok', file.type='gz');
#'	install.from.url(url='http://domain.de/mypackage.gz?parameters=areok'); ## file type will be automatically detected
#'	install.from.url(url='http://domain.de/mypackage?parameters=areok');
#'	path <- install.from.url(url='http://domain.de/mypackage?parameters=areok', install=FALSE);
#'	install.packages(pkgs=path, repos=NULL, type='source');
#'	path <- install.from.url(url='http://domain.de/mypackage?parameters=areok', install=FALSE, pkg.name='mypackage', require.pkg=TRUE); ## tries require('mypackage') first, otherwise installs package afresh.
#'	path <- install.from.url(url='http://domain.de/mypackage?parameters=areok', install=FALSE, require.pkg=TRUE, force=TRUE); ## forces a fresh installation of the package followed by a require(···) command (package name will be automatically detected).
#' }
#'
#' @keywords syntax load install packages URL

install.from.url <- function(pkg.name=NULL, url=NULL, file.type=NULL, install=TRUE, require.pkg=FALSE, dependencies=c('Depends', 'Imports'), force=FALSE) {
	## Versuche Package zu laden, solange force=FALSE;
	if(is.character(pkg.name) && !force && require.pkg) {
		base::message(paste0('Attempting to load Package `',pkg.name,'`.'));
		if(base::require(pkg.name, character.only=TRUE)) return(TRUE);
	}
	## Erstelle downloaded_packages-Ordner, falls dies nicht existiert:
	downloadfolder <- base::file.path(base::tempdir(), 'downloaded_packages');
	if(!('downloaded_packages' %in% base::list.dirs(path=base::tempdir(), full.names=FALSE, recursive=FALSE))) base::dir.create(downloadfolder);
	## Datei von URL herunterladen:
	file <- base::tempfile(tmpdir=downloadfolder);
	utils::download.file(url, destfile=file, mode='wb');

	if(base::file.info(file)$isdir) {
		pfad <- file;
		tmpdir <- file;
	} else {
		if(!is.character(file.type)) {
			if(.Platform$OS.type == 'unix') { ## MAC OSX / Linux
				file_infos <- base::system(paste0('file -I ',file), intern=TRUE);
				file.type <- gsub('^.*:\\s*\\w*\\s*\\/\\s*(\\w*)\\s*;\\s*\\w*\\s*\\=\\s*\\w*\\s*.*$', '\\1', file_infos, perl=TRUE)
			} else { ## Windows
				## daran muss noch gebastelt werden:
				# file_infos <- base::shell(paste0('filetype -i ',file), intern=TRUE);
				file.type <- 'zip';
			}
		}
		## Temp-Ordner erstellen:
		currenttmpfolders <- base::list.dirs(path=downloadfolder, full.names=FALSE, recursive=FALSE);
		i <- 0;
		while(paste0('tmp', i) %in% currenttmpfolders) i <- i + 1;
		tmpdir <- base::file.path(downloadfolder, paste0('tmp', i));
		## Datei entpacken:
		is_unpacked <- FALSE;
		if(is.character(file.type)) {
			is_unpacked <- TRUE;
			if(file.type=='zip') {
				utils::unzip(zipfile=file, exdir=tmpdir);
			} else if(file.type=='tar') {
				utils::untar(file, exdir=tmpdir);
			} else if(file.type=='gz') {
				utils::untar(file, exdir=tmpdir);
			## daran muss noch gebastelt werden:
			# } else if(file.type=='7z') {
			# 	# utils::unzip(zipfile=file, exdir=tmpdir);
			} else {
				is_unpacked <- FALSE;
			}
		}
		base::unlink(file);
		if(is_unpacked) {
			## Package-Root finden:
			pfad <- findDESCRIPTION(tmpdir);
		} else {
			pfad <- NULL;
		}
	}

	## vom Package-Root installieren:
	if(is.character(pfad)) {
		if(install) {
			## Package-Namen von der Description-Datei zu extrahieren versuchen:
			descr <- utils::read.delim(file=file.path(pfad, 'DESCRIPTION'), sep=':', head=FALSE, col.names=c('key','value'), stringsAsFactors=FALSE);
			idx <- which(grepl('Package', descr$key, ignore.case=TRUE))[1];
			if(!is.na(idx)) pkg.name <- gsub('^\\s*(\\w*).*', '\\1', descr$value[idx]);
			## Versuche ggf. Package zu laden (solange force=FALSE, require.pkg=TRUE und pkg.name ein String):
			skip_install <- FALSE;
			if(is.character(pkg.name) && !force && require.pkg) {
				base::message(paste0('Attempting to load Package `',pkg.name,'`.'));
				skip_install <- base::require(pkg.name, character.only=TRUE);
			}
			## Package vom Temp-Ordner installieren (außer voriges require erfolgreich durchgeführt):
			if(!skip_install) {
				if(is.character(pkg.name)) base::message(paste0('Attempting to install Package `',pkg.name,'`.'));
				utils::install.packages(pkgs=pfad, repos=NULL, type='source', dependencies=dependencies);
			}
			base::unlink(tmpdir, recursive=TRUE);
			## Versuche ggf. Package zu laden:
			if(require.pkg) {
				pkg_loaded <- skip_install; ## wenn Intall übersprungen wurde, dann wurde Pkg schon geladen.
				if(!pkg_loaded && is.character(pkg.name)) {
					base::message(paste0('Attempting to load Package `',pkg.name,'`.'));
					pkg_loaded <- base::require(pkg.name, character.only=TRUE);
				}
				return(pkg_loaded);
			}
			invisible(NULL);
		} else {
			return(pfad);
		}
	} else {
		warning('No package contents could be found!');
		if(install) {
			base::unlink(tmpdir, recursive=TRUE);
			if(require.pkg) return(FALSE);
			invisible(NULL);
		} else {
			return(tmpdir);
		}
	}
};


findDESCRIPTION <- function(p) {
	path <- p;
	if(!('DESCRIPTION' %in% base::list.files(path=p, full.names=FALSE, recursive=FALSE))) {
		subfolders <- base::list.dirs(path=p, full.names=TRUE, recursive=FALSE);
		path <- NULL;
		for(pp in subfolders) {
			path <- findDESCRIPTION(pp);
			if(is.character(path)) break;
		}
	}
	return(path);
};




#' @title compile.package
#' @description Compiles R package using roxygen2.
#' @export compile.package
#'
#' @usage \code{compile.package(path=STRING, as.test=BOOL)}
#' @param path path name of package.
#' @param as.test default to \code{FALSE}. If set to \code{TRUE}, will install package locally without compilation. If set to \code{FALSE}/unset will compile via roxygen.
#'
#' @examples \dontrun{
#'	compile.package(path='~/Documents/R/packages/mytestpackage');
#'	compile.package(path='~/Documents/R/packages/mytestpackage', as.test=TRUE);
#' };
#'
#' @keywords syntax compile package

compile.package <- function(path='.', as.test=FALSE) {
	if(!require('roxygen2')) {
		devtools::install_github('klutometis/roxygen');
		library('roxygen2');
	}

	if(as.test) {
		utils::install.packages(pkgs=path, repos=NULL, type='source', dependencies=c('Imports', 'Dependencies'));
	} else {
		name <- gsub('.*(\\\\|\\/)', '', path, perl=TRUE);
		currdir <- getwd();
		setwd(path);
		devtools::document();
		setwd('..');
		devtools::install(name);
		setwd(currdir);
	}
};