Nothing
print.ctv <- function(x, packagelist = TRUE, ...)
{
cat(paste("CRAN Task View\n--------------\nName: ",
x$name,
"\nTopic: ", x$topic,
"\nMaintainer: ", x$maintainer,
if(!is.null(x$email)) sprintf("\nContact: %s", x$email),
sprintf("\nVersion: %s", x$version),
if(!is.null(x$url)) sprintf("\nURL: %s", x$url),
if(!is.null(x$repository)) sprintf("\nRepository: %s", x$repository),
if(!is.null(x$source)) sprintf("\nSource: %s", x$source),
"\n", sep = ""))
if(packagelist) {
pkgs <- paste(strwrap(paste(x$packagelist$name, ifelse(x$packagelist$core, "*", ""), sep = "", collapse = ", "),
width = getOption("width"), prefix = " "), collapse = "\n")
substr(pkgs, 1, 9) <- "Packages:"
cat(pkgs)
if(any(x$packagelist$core)) cat("\n (* = core package)\n")
}
invisible(x)
}
print.ctvlist <- function(x, packagelist = FALSE, ...)
{
cat("\nCRAN Task Views\n")
n <- length(x)
if(n < 1)
cat("no views found\n")
else {
for(i in seq_along(x)) {
cat(paste("---------------\nName: ",
x[[i]]$name, "\nTopic: ",
x[[i]]$topic, "\nMaintainer: ",
x[[i]]$maintainer, "\n",
ifelse(is.null(x[[i]]$repository), "", paste("Repository: ", x[[i]]$repository, "\n", sep = "")),
sep = ""))
if(packagelist) {
cat(paste("Packages:",
paste(x[[i]]$packagelist$name, ifelse(x[[i]]$packagelist$core, "*", ""), sep = "", collapse = ", "),
"\n"))
cat(ifelse(any(x[[i]]$packagelist$core), "(* = core package)\n", ""))
}
}
cat("\n")
}
invisible(x)
}
available.views <- CRAN.views <- function(repos = NULL, ...)
{
## getOption("repos") replaces getOption("CRAN") from 2.1.0 on
if(is.null(repos)) repos <- ifelse(is.null(getOption("repos")), getOption("CRAN"), getOption("repos"))
if("@CRAN@" %in% repos && interactive()) {
cat(gettext("--- Please select a CRAN mirror for use in this session ---\n"))
flush.console()
chooseCRANmirror()
m <- match("@CRAN@", repos)
nm <- names(repos)
repos[m] <- getOption("repos")["CRAN"]
if(is.null(nm)) nm <- rep("", length(repos))
nm[m] <- "CRAN"
names(repos) <- nm
}
if("@CRAN@" %in% repos) stop("trying to use CRAN without setting a mirror")
contriburl <- paste(repos, "/src/contrib", sep = "")
rval <- list()
for(i in seq(along.with = contriburl)) {
## load Views.rds from repository
viewurl <- gzcon(url(paste(contriburl[i], "Views.rds", sep = "/"), open = "rb"))
x <- suppressWarnings(try(readRDS(viewurl), silent = TRUE))
if(inherits(x, "try-error")) next else close(viewurl)
## add repository information
for(j in seq_along(x)) x[[j]]$repository <- repos[i]
rval <- c(rval, x)
}
names(rval) <- sapply(rval, "[[", "name")
class(rval) <- "ctvlist"
return(rval)
}
ctv <- function(view, repos = NULL, ...) {
a <- available.views(repos = repos, ...)
if(!(view %in% names(a))) stop(sprintf("No task view with name '%s' available from the repository.", view))
return(a[[view]])
}
.get_pkgs_from_ctv_or_repos <- function(views, coreOnly = FALSE, repos = NULL)
{
## views is already a "ctv"
if(inherits(views, "ctv")) {
views <- list(views)
class(views) <- "ctvlist"
}
## views is a string that needs to be turned to "ctv"
if(!inherits(views, "ctvlist")) {
## get CRAN views and extract names of available views
cranviews <- available.views(repos = repos)
availnames <- sapply(seq_along(cranviews), function(i) cranviews[[i]]$name)
whichviews <- lapply(views, function(z) {
rval <- which(z == availnames)
if(length(rval) > 0L) rval[1] else numeric(0L)
})
unavail <- which(sapply(whichviews, length) < 1L)
if(length(unavail) > 0L) warning(paste("CRAN task view", views[unavail], "not available", collapse = "\n"))
views <- cranviews[as.vector(unlist(whichviews))]
class(views) <- "ctvlist"
}
## compute list of unique packages for each repository
coreOnly <- rep(coreOnly, length.out = length(views))
pkgs <- lapply(seq_along(views), function(i) {
pkgs <- if(!coreOnly[i]) views[[i]]$packagelist$name
else views[[i]]$packagelist$name[views[[i]]$packagelist$core]
cbind(pkgs, views[[i]]$repository)
})
pkgs <- do.call("rbind", pkgs)
pkgs <- tapply(pkgs[, 1L], pkgs[, 2L], function(x) sort(unique(x)))
return(pkgs)
}
install.views <- function(views, coreOnly = FALSE, repos = NULL, ...)
{
pkgs <- .get_pkgs_from_ctv_or_repos(views = views, coreOnly = coreOnly, repos = repos)
for(i in seq_along(pkgs)) install.packages(pkgs[[i]], repos = names(pkgs)[i], ...)
invisible()
}
download.views <- function(views, destdir, coreOnly = FALSE, repos = NULL, ...)
{
pkgs <- .get_pkgs_from_ctv_or_repos(views = views, coreOnly = coreOnly, repos = repos)
for(i in seq_along(pkgs)) download.packages(pkgs[[i]], destdir = destdir, repos = names(pkgs)[i], ...)
invisible()
}
update.views <- function(views, coreOnly = FALSE, repos = NULL, lib.loc = NULL, filters = NULL, ...)
{
pkg_list <- .get_pkgs_from_ctv_or_repos(views = views, coreOnly = coreOnly, repos = repos)
for(i in seq_along(pkg_list)) {
## package and repos name(s)
pkgs <- pkg_list[[i]]
repos <- names(pkg_list)[i]
## query available packages
apkgs <- available.packages(contriburl = contrib.url(repos), filters = filters)
## compute intersection
unavail <- which(!(pkgs %in% as.character(apkgs[, 1L])))
if(length(unavail) > 0L) {
warning(sprintf("The following packages are not available: %s", paste(pkgs[unavail], collapse = ", ")))
pkgs <- pkgs[-unavail]
}
apkgs <- apkgs[pkgs, , drop = FALSE]
## query installed packages
ipkgs <- installed.packages(lib.loc = lib.loc)
ipkgs <- ipkgs[which(ipkgs[, "Package"] %in% pkgs), , drop = FALSE]
## determine which packages need to be updated
if(NROW(ipkgs) > 0L) {
not_installed <- which(!(pkgs %in% ipkgs[, 1L]))
cpkgs <- if(length(not_installed) > 0L) pkgs[-not_installed] else pkgs
get_highest_version <- function(x)
as.character(max(package_version(ipkgs[which(ipkgs[, 1L] %in% x),"Version"])))
not_uptodate <- which(package_version(apkgs[cpkgs, "Version"]) >
package_version(sapply(cpkgs, get_highest_version)))
pkgs <- sort(c(pkgs[not_installed], cpkgs[not_uptodate]))
}
## install packages required
apkgs <- apkgs[pkgs, , drop = FALSE]
if(NROW(apkgs) > 0L) install.packages(apkgs[, 1L], repos = repos, lib = lib.loc, ...)
}
invisible()
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.