SCM

SCM Repository

[rmetrics] View of /www/installRmetrics.R
ViewVC logotype

View of /www/installRmetrics.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3172 - (download) (annotate)
Tue Apr 8 09:13:53 2008 UTC (6 years, 3 months ago) by chalabi
Original Path: pkg/installRmetrics.R
File size: 4486 byte(s)
updated install script
################################################################################
## **Install Rmetrics packages**
##
## This script installs Rmetrics packages either from source or from
## remote server (i.e. R-Forge). It ensures that all dependent
## Rmetrics packages are installed from the same location, i.e. remote
## server. This is important to avoid compatibility problem between
## development packages and packages available on CRAN.
##
## *An Example with fSeries*
##
## _Local packages_
##
## Open an R process and set its working directory to this directory.
## Then type the following :
##
## > source("installRmetrics.R")
## > installRmetrics("fSeries")
##
## _Packages at R-Forge_
##
## > source("installRmetrics.R")
## > installRmetrics("fSeries", repos="http://R-Forge.R-project.org")
##
################################################################################

installRmetrics  <-
    function(pkgs = "Rmetrics", repos = NULL,
             CRAN = "http://stat.ethz.ch/CRAN/",
             suggests = TRUE, ...)
{

    stopifnot(is.character(pkgs))

    infokind <- c("Depends", "Imports", if (suggests) "Suggests")

    if (!is.null(repos))
        available <- available.packages(contrib.url(repos), method = "auto")

    # list of Rmetrics packages
    pkgsRmetrics <- getDESCR("Rmetrics", infokind,
                             if (!is.null(repos)) available)
    pkgsRmetrics <- c(pkgsRmetrics, "Rmetrics")

    # test if requested package is part of Rmetrics
    if (!(pkgs %in% c(pkgsRmetrics, "Rmetrics")))
        stop(gettextf("'%s' is not part of Rmetrics",
                      deparse(substitute(pkgs))))

    pkgsDepends <- getDepends(pkgs, pkgsRmetrics, infokind,
                              if (!is.null(repos)) available)

    ## remove Rmetrics packages and duplicate entries
    ## --> only "outside dependencies"
    all <- c(pkgsDepends, pkgs)
    depends <- unique(all[!(all %in% pkgsRmetrics)])
    pkgs <- unique(all[(all %in% pkgsRmetrics)])

    ## Remove Rdonlp2 and Rsocp because they are not available at CRAN server
    depends <- depends[!(depends %in% c("Rdonlp2", "Rsocp"))]

    ## disable unnecessary warning message when package is not installed
    ow <- options(warn = -1)
    ## install third party packages if not already installed
    for (i in seq_along(depends)) {
        if (!require(depends[i], character.only = TRUE, quietly = TRUE)) {
            message("installing package ", depends[i],
                    " from CRAN ", CRAN, " ...")
            install.packages(depends[i], repos = CRAN, ...)
        }
    }
    ### # Note Rdonlp2 is not part of Rmetrics !!
    ### if (!require(Rdonlp2, quietly = TRUE)) {
    ### install.packages("Rdonlp2", repos = repoRmetrics, type = "source", ...)
    ### }
    options(ow) # set default warning option

    # pkgs in good order for install
    pkgs <- pkgsRmetrics[sort(match(pkgs, pkgsRmetrics))]

    ## install Rmetrics packages
    install.packages(pkgs, repos = repos, ...)

    ## Return
    return(TRUE)
}

getDESCR <- function(package, infokind, available = NULL)
{
    stopifnot(is.character(package))
    ans <- unlist(lapply(package, function(pkg)
                     {
                         if (is.null(available)) {
                             # if available NULL try to read from
                             # local directroy
                             descr <- file.path(pkg, "DESCRIPTION")
                             descr <- tools:::.read_description(descr)
                         } else {
                             descr <- available[pkg, ]
                         }
                         tools:::.split_description(na.omit(descr))[ infokind ]
                         # na.omit important when reading files obtain from
                         # available.packages
                     }), recursive = TRUE)
    as.character(ans)
}

getDepends <- function(package, group, infokind, available = NULL)
{
    # extract recursively dependencies of a package which belongs to a
    # specific group of packages
    getDESCR <- match.fun(getDESCR)
    pkgsDepends <- NULL
    pkgsTested <- NULL
    while (length(package)) {
        pkgsDepends <-  c(pkgsDepends,
                          unlist(getDESCR(package, infokind, available)))
        pkgsTested <- c(pkgsTested, package)
        test <- pkgsDepends[pkgsDepends %in% group]
        package <- test[!(test %in% pkgsTested)]
    }
    unique(as.character(pkgsDepends))
}

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge