library(): possibly the most common function call in R. What does it do? This is a dissection of the prolific function.

The function is surprisingly long, let’s work through it line by line.

For reference, here’s the full function.

function (package, help, pos = 2, lib.loc = NULL, character.only = FALSE, 
    logical.return = FALSE, warn.conflicts = TRUE, quietly = FALSE, 
    verbose = getOption("verbose"))
{

The library() function itself relies on four (testRversion, checkLicense, checkNoGenerics, and checkConflicts) internal functions to operate. As is customary, they’re specified up front. Rather than work through the functions without context, we’ll save them for dissection until the point they’re called.

    if (verbose && quietly) 
        message("'verbose' and 'quietly' are both true; being verbose then ..")

After the four internal functions are specified, library() begins with a check of the verbose and quietly arguments to see if they both happen to be specified as TRUE. If they are, a message is printed stating that verbose mode will be assumed.

Next up, the function splits on three main branches of logic determined by the arguments package and help (or neither if library() is called. We’ll start with the case that a package has been given like library(ggplot2).

    if (!missing(package)) {
        if (is.null(lib.loc)) 
            lib.loc <- .libPaths()

If lib.loc is NULL, as it is by default, it’s obtained by .libPaths(). On my OS X machine that’s,

[1] "/Users/statwonk/Library/R/3.2/library"                         
[2] "/Library/Frameworks/R.framework/Versions/3.2/Resources/library"

Next a quick check that the paths exist. Could it be that .libPaths() might return a non-existent path?

        lib.loc <- lib.loc[dir.exists(lib.loc)]

library() can be used like library("survival") or without quotes like library(survival). The default case is that character.only is FALSE, and in that case the substitute function will capture the expression package and convert it to a character vector.

        if (!character.only) 
            package <- as.character(substitute(package))

My bet is that character.only is kept around almost exclusively for backwards compatability. It would seem like a possible route for removal is to redefine library() with ... “dots”. That would allow this if statement to be removed and avoid breaking calls that include character.only = {TRUE, FALSE}.

Next up are two simple defensive checks on the package argument. It must be of length one so library(package = c("survival", "mgcv")) isn’t valid. Nor is NA or "".

        if (length(package) != 1L) 
            stop("'package' must be of length 1")
        if (is.na(package) || (package == "")) 
            stop("invalid package name")

Interesting. package is converted into package:package (e.g. package:survival) for actual use as pkgname.

        pkgname <- paste("package", package, sep = ":")

Next up, the authors check to see if we’ve already attached the package’s search() path.

        newpackage <- is.na(match(pkgname, search()))

If we haven’t attached a package like survival to the search path (perhaps by calling library(survival)), they’re be no match in search() and the result is NA. Then newpackage becomes a boolean (TRUE / FALSE) that the author uses to again branch logic and avoid work in the case the package is already attached.

        if (newpackage) {

The first bit of work is to find the package. It’s interesting that quiet and verbose can again be in conflict.

            pkgpath <- find.package(package, lib.loc, quiet = TRUE, 
                verbose = verbose)

The next bit checks that the package is actually found using the find.packages function. The

            if (length(pkgpath) == 0L) {
                txt <- if (length(lib.loc)) 
                  gettextf("there is no package called %s", sQuote(package))
                  else gettext("no library trees found in 'lib.loc'")

The check above is why you might get,

> library("I don't exist!")
Error in library("I don't exist!") : 
  there is no package called ‘I don't exist!’

if you ask for a package that doesn’t exist. The second part of the conditional checks there’s a valid lib.loc variable (that should be a search path).

If either of these cases is triggered and logical.return is TRUE, a warning is printed and FALSE is returned. Yeesh, lots of conditional nesting.

                if (logical.return) {
                  warning(txt, domain = NA)
                  return(FALSE)
                }
                else stop(txt, domain = NA)
            }

So far I have two big impressesion:

  1. Wow, the definition of library() is suuuuper long.
  2. The code relies heavily on variables.with.names.like.this.

My understanding is that the next line converts a relative path to an absolute path. It also has the nifty feature of specifying winslash as / for Windows.

            which.lib.loc <- normalizePath(dirname(pkgpath), 
                "/", TRUE)

For example,

> normalizePath("../..")
[1] "/Users/statwonk/repos"

Then which.lib.loc is used to load package … meta data?

            pfile <- system.file("Meta", "package.rds", package = package, 
                lib.loc = which.lib.loc)

Interesting aside: system.file(..., package = "base", lib.loc = NULL, mustWork = FALSE) has “dots” (...) as the first argument. I think this is my first time seeing it specified in first position apart from single argument functions like function(...).

            if (!nzchar(pfile)) 
                stop(gettextf("%s is not a valid installed package", 
                  sQuote(package)), domain = NA)

nzchar just checks that pfile is not an empty string like "". Unless I’m missing something, this seems like a really thin test of Meta’s structure.

            pkgInfo <- readRDS(pfile)

Finally, we arrive at the call of the first internal function.1. The lack of assignment tells me its behavior is likey by side-effect.

            testRversion(pkgInfo, package, pkgpath)

Next up checkLicense2. If a user has checkPackageLicense set as an option(), the license is then checked. Similar to testRversion, I’m guessing the function operates by side-effect, that is it doesn’t have a meaningful return value (that’s used). The process is short-circuited3 with the list containing built-in R packages like datasets and grDevices.

            if (!package %in% c("datasets", "grDevices", "graphics", 
                "methods", "splines", "stats", "stats4", "tcltk", 
                "tools", "utils") && isTRUE(getOption("checkPackageLicense", 
                FALSE))) 
                checkLicense(package, pkgInfo, pkgpath)

pos, position? A quick check of ?library reveals, “the position on the search list at which to attach the loaded namespace.” Somehow I’ve gotten by with the default pos = 2 all these years. The help text follows up with,

Can also be the name of a position on the current search list as given by search().

I see, this is the case caught with is.character, then the process of matching to the search path happens. If the name isn’t found the default is re-installed (pos <- 2).

            if (is.character(pos)) {
                npos <- match(pos, search())
                if (is.na(npos)) {
                  warning(gettextf("%s not found on search path, using pos = 2", 
                    sQuote(pos)), domain = NA)
                  pos <- 2
                }
                else pos <- npos
            }

Oh my. .getRequiredPackages2 otherwise known by its definition. This monster function loads all of the other packages your package depends on.

            .getRequiredPackages2(pkgInfo, quietly = quietly)

What follows is an elaborate dance of checking the versions of attached packages (when library() was called), unloading them and installing new versions (or not if the version hasn’t changed).

deps are peeled off for later use with attachNamespace.

            deps <- unique(names(pkgInfo$Depends))

The dance begins …

            if (packageHasNamespace(package, which.lib.loc)) {
                if (isNamespaceLoaded(package)) {
                  newversion <- as.numeric_version(pkgInfo$DESCRIPTION["Version"])
                  oldversion <- as.numeric_version(getNamespaceVersion(package))
                  if (newversion != oldversion) {
                    res <- try(unloadNamespace(package))
                    if (inherits(res, "try-error")) 
                      stop(gettextf("Package %s version %s cannot be unloaded", 
                        sQuote(package), oldversion, domain = "R-base"))
                  }
                }

A lot of action happens in the next several lines. The function loadNamespace basically puts a package’s namespace information into internal storage within the R process. R’s ?attachNamespace doc says,

attachNamespace can be used to attach a frame containing the exported values of a name space to the search path

                tt <- try({
                  ns <- loadNamespace(package, c(which.lib.loc, 
                    lib.loc))
                  env <- attachNamespace(ns, pos = pos, deps)
                })

A-ha, and error many of us are probably familiar with: package or namespace load failed for [package]. My goto in this case is restarting R. This probably works due to refreshing the state of R and clearing any locks to the namespace in the process.

                if (inherits(tt, "try-error")) 
                  if (logical.return) 
                    return(FALSE)
                  else stop(gettextf("package or namespace load failed for %s", 
                    sQuote(package)), call. = FALSE, domain = NA)

If the process to attach the namespace fails, either a FALSE if logical.return is specified otherwise a generic error message.

                else {
                  on.exit(detach(pos = pos))

The on.exit calls will ensure detach(pos = pos)) is called when the function returns. This ensures, I believe that the position on the search path is not altered?

checkNoGenerics is an internally-defined function.4

                  nogenerics <- !.isMethodsDispatchOn() || checkNoGenerics(env, 
                    package)

Another argument I’ve never needed to change: warn.conflicts. I vaguely recall having seen conflict errors in the past, but it’s a very rare problem to me. It can happen when there are two identical names on the search() path. Another internally defined function appears checkConflicts5.

                  if (warn.conflicts && !exists(".conflicts.OK", 
                    envir = env, inherits = FALSE)) 
                    checkConflicts(package, pkgname, pkgpath, 
                      nogenerics, ns)
                  on.exit()

If namespace attaching goes well and logical.return is specified, a TRUE is returned. “Otherwise” is a bit more interesting. The .packages() function is called. The function itself returns invisible? I’ve seen invisible from time-to-time, but it’s a mystery to me. When is it useful? It’s basically return sans printing? Why return .packages? The mystery deepens …

                  if (logical.return) 
                    return(TRUE)
                  else return(invisible(.packages()))
                }
            }
            else stop(gettextf("package %s does not have a namespace and should be re-installed", 
                sQuote(package)), domain = NA)
        }
        if (verbose && !newpackage) 
            warning(gettextf("package %s already present in search()", 
                sQuote(package)), domain = NA)
    }

I’ve never really used the library(help = "ggplot2"), but I think I’ll start. Of particular interest is the way each exported function is listed.

    else if (!missing(help)) {
        if (!character.only) 
            help <- as.character(substitute(help))
        pkgName <- help[1L]
        pkgPath <- find.package(pkgName, lib.loc, verbose = verbose)
        docFiles <- c(file.path(pkgPath, "Meta", "package.rds"), 
            file.path(pkgPath, "INDEX"))
        if (file.exists(vignetteIndexRDS <- file.path(pkgPath, 
            "Meta", "vignette.rds"))) 
            docFiles <- c(docFiles, vignetteIndexRDS)
        pkgInfo <- vector("list", 3L)
        readDocFile <- function(f) {
            if (basename(f) %in% "package.rds") {
                txt <- readRDS(f)$DESCRIPTION
                if ("Encoding" %in% names(txt)) {
                  to <- if (Sys.getlocale("LC_CTYPE") == "C") 
                    "ASCII//TRANSLIT"
                  else ""
                  tmp <- try(iconv(txt, from = txt["Encoding"], 
                    to = to))
                  if (!inherits(tmp, "try-error")) 
                    txt <- tmp
                  else warning("'DESCRIPTION' has an 'Encoding' field and re-encoding is not possible", 
                    call. = FALSE)
                }
                nm <- paste0(names(txt), ":")
                formatDL(nm, txt, indent = max(nchar(nm, "w")) + 
                  3)
            }
            else if (basename(f) %in% "vignette.rds") {
                txt <- readRDS(f)
                if (is.data.frame(txt) && nrow(txt)) 
                  cbind(basename(gsub("\\.[[:alpha:]]+$", "", 
                    txt$File)), paste(txt$Title, paste0(rep.int("(source", 
                    NROW(txt)), ifelse(nzchar(txt$PDF), ", pdf", 
                    ""), ")")))
                else NULL
            }
            else readLines(f)
        }
        for (i in which(file.exists(docFiles))) pkgInfo[[i]] <- readDocFile(docFiles[i])
        y <- list(name = pkgName, path = pkgPath, info = pkgInfo)
        class(y) <- "packageInfo"
        return(y)
    }

Another bit of functionality I didn’t know existed! library() called without a package or help argument will list all of the packages installed on your system. Very cool.

    else {
        if (is.null(lib.loc)) 
            lib.loc <- .libPaths()
        db <- matrix(character(), nrow = 0L, ncol = 3L)
        nopkgs <- character()
        for (lib in lib.loc) {
            a <- .packages(all.available = TRUE, lib.loc = lib)
            for (i in sort(a)) {
                file <- system.file("Meta", "package.rds", package = i, 
                  lib.loc = lib)
                title <- if (nzchar(file)) {
                  txt <- readRDS(file)
                  if (is.list(txt)) 
                    txt <- txt$DESCRIPTION
                  if ("Encoding" %in% names(txt)) {
                    to <- if (Sys.getlocale("LC_CTYPE") == "C") 
                      "ASCII//TRANSLIT"
                    else ""
                    tmp <- try(iconv(txt, txt["Encoding"], to, 
                      "?"))
                    if (!inherits(tmp, "try-error")) 
                      txt <- tmp
                    else warning("'DESCRIPTION' has an 'Encoding' field and re-encoding is not possible", 
                      call. = FALSE)
                  }
                  txt["Title"]
                }
                else NA
                if (is.na(title)) 
                  title <- " ** No title available ** "
                db <- rbind(db, cbind(i, lib, title))
            }
            if (length(a) == 0L) 
                nopkgs <- c(nopkgs, lib)
        }
        dimnames(db) <- list(NULL, c("Package", "LibPath", "Title"))
        if (length(nopkgs) && !missing(lib.loc)) {
            pkglist <- paste(sQuote(nopkgs), collapse = ", ")
            msg <- sprintf(ngettext(length(nopkgs), "library %s contains no packages", 
                "libraries %s contain no packages"), pkglist)
            warning(msg, domain = NA)
        }
        y <- list(header = NULL, results = db, footer = NULL)
        class(y) <- "libraryIQR"
        return(y)
    }
    if (logical.return) 
        TRUE
    else invisible(.packages())
}

There we have it! That’s library()! I had a lot of fun writing this, it was mostly to learn this common function that I’ve used daily for years. If you see a mistake or want to send kudos, you can find me on Twitter @statwonk.

P.S — for goot measure, the whole thing is bytecoded. That’s 0x10612d750 folks!

# <bytecode: 0x10612d750>
# <environment: namespace:base>

  1. testRversion <- function(pkgInfo, pkgname, pkgpath)

    The function takes three inputs. It’s not an exported function, so we don’t have an associated help page to work off.

    {
        if (is.null(built <- pkgInfo$Built)) 
            stop(gettextf("package %s has not been installed properly\n", 
                sQuote(pkgname)), call. = FALSE, domain = NA)
        R_version_built_under <- as.numeric_version(built$R)
        if (R_version_built_under < "3.0.0") 
            stop(gettextf("package %s was built before R 3.0.0: please re-install it", 
                sQuote(pkgname)), call. = FALSE, domain = NA)
        current <- getRversion()
        if (length(Rdeps <- pkgInfo$Rdepends2)) {
            for (dep in Rdeps) if (length(dep) > 1L) {
                target <- dep$version
                res <- if (is.character(target)) {
                  do.call(dep$op, list(as.numeric(R.version[["svn rev"]]), 
                    as.numeric(sub("^r", "", dep$version))))
                }
                else {
                  do.call(dep$op, list(current, as.numeric_version(target)))
                }
                if (!res) 
                  stop(gettextf("This is R %s, package %s needs %s %s", 
                    current, sQuote(pkgname), dep$op, target), 
                    call. = FALSE, domain = NA)
            }
        }
        if (R_version_built_under > current) 
            warning(gettextf("package %s was built under R version %s", 
                sQuote(pkgname), as.character(built$R)), call. = FALSE, 
                domain = NA)
        platform <- built$Platform
        r_arch <- .Platform$r_arch
        if (.Platform$OS.type == "unix") {
            if (!nzchar(r_arch) && length(grep("\\w", platform)) && 
                !testPlatformEquivalence(platform, R.version$platform)) 
                stop(gettextf("package %s was built for %s", 
                  sQuote(pkgname), platform), call. = FALSE, 
                  domain = NA)
        }
        else {
            if (nzchar(platform) && !grepl("mingw", platform)) 
                stop(gettextf("package %s was built for %s", 
                  sQuote(pkgname), platform), call. = FALSE, 
                  domain = NA)
        }
        if (nzchar(r_arch) && file.exists(file.path(pkgpath, 
            "libs")) && !file.exists(file.path(pkgpath, "libs", 
            r_arch))) 
            stop(gettextf("package %s is not installed for 'arch = %s'", 
                sQuote(pkgname), r_arch), call. = FALSE, domain = NA)
    }
  2. checkLicense <- function(pkg, pkgInfo, pkgPath) {
        L <- tools:::analyze_license(pkgInfo$DESCRIPTION["License"])
        if (!L$is_empty && !L$is_verified) {
            site_file <- path.expand(file.path(R.home("etc"), 
                "licensed.site"))
            if (file.exists(site_file) && pkg %in% readLines(site_file)) 
                return()
            personal_file <- path.expand("~/.R/licensed")
            if (file.exists(personal_file)) {
                agreed <- readLines(personal_file)
                if (pkg %in% agreed) 
                  return()
            }
            else agreed <- character()
            if (!interactive()) 
                stop(gettextf("package %s has a license that you need to accept in an interactive session", 
                  sQuote(pkg)), domain = NA)
            lfiles <- file.path(pkgpath, c("LICENSE", "LICENCE"))
            lfiles <- lfiles[file.exists(lfiles)]
            if (length(lfiles)) {
                message(gettextf("package %s has a license that you need to accept after viewing", 
                  sQuote(pkg)), domain = NA)
                readline("press RETURN to view license")
                encoding <- pkgInfo$DESCRIPTION["Encoding"]
                if (is.na(encoding)) 
                  encoding <- ""
                if (encoding == "latin1") 
                  encoding <- "cp1252"
                file.show(lfiles[1L], encoding = encoding)
            }
            else {
                message(gettextf("package %s has a license that you need to accept:\naccording to the DESCRIPTION file it is", 
                  sQuote(pkg)), domain = NA)
                message(pkgInfo$DESCRIPTION["License"], domain = NA)
            }
            choice <- menu(c("accept", "decline"), title = paste("License for", 
                sQuote(pkg)))
            if (choice != 1) 
                stop(gettextf("license for package %s not accepted", 
                  sQuote(package)), domain = NA, call. = FALSE)
            dir.create(dirname(personal_file), showWarnings = FALSE)
            writeLines(c(agreed, pkg), personal_file)
        }
    }
  3. See 8.2.17 and and andand http://www.burns-stat.com/pages/Tutor/R_inferno.pdf

  4. checkNoGenerics <- function(env, pkg) {
        nenv <- env
        ns <- .getNamespace(as.name(pkg))
        if (!is.null(ns)) 
            nenv <- asNamespace(ns)
        if (exists(".noGenerics", envir = nenv, inherits = FALSE)) 
            TRUE
        else {
            length(objects(env, pattern = "^\\.__T", all.names = TRUE)) == 
                0L
        }
    }
  5. checkConflicts <- function(package, pkgname, pkgpath, nogenerics, 
        env) {
        dont.mind <- c("last.dump", "last.warning", ".Last.value", 
            ".Random.seed", ".Last.lib", ".onDetach", ".packageName", 
            ".noGenerics", ".required", ".no_S3_generics", ".Depends", 
            ".requireCachedGenerics")
        sp <- search()
        lib.pos <- match(pkgname, sp)
        ob <- objects(lib.pos, all.names = TRUE)
        if (!nogenerics) {
            these <- ob[substr(ob, 1L, 6L) == ".__T__"]
            gen <- gsub(".__T__(.*):([^:]+)", "\\1", these)
            from <- gsub(".__T__(.*):([^:]+)", "\\2", these)
            gen <- gen[from != package]
            ob <- ob[!(ob %in% gen)]
        }
        fst <- TRUE
        ipos <- seq_along(sp)[-c(lib.pos, match(c("Autoloads", 
            "CheckExEnv"), sp, 0L))]
        for (i in ipos) {
            obj.same <- match(objects(i, all.names = TRUE), ob, 
                nomatch = 0L)
            if (any(obj.same > 0)) {
                same <- ob[obj.same]
                same <- same[!(same %in% dont.mind)]
                Classobjs <- grep("^\\.__", same)
                if (length(Classobjs)) 
                  same <- same[-Classobjs]
                same.isFn <- function(where) vapply(same, exists, 
                  NA, where = where, mode = "function", inherits = FALSE)
                same <- same[same.isFn(i) == same.isFn(lib.pos)]
                not.Ident <- function(ch, TRAFO = identity, ...) vapply(ch, 
                  function(.) !identical(TRAFO(get(., i)), TRAFO(get(., 
                    lib.pos)), ...), NA)
                if (length(same)) 
                  same <- same[not.Ident(same)]
                if (length(same) && identical(sp[i], "package:base")) 
                  same <- same[not.Ident(same, ignore.environment = TRUE)]
                if (length(same)) {
                  if (fst) {
                    fst <- FALSE
                    packageStartupMessage(gettextf("\nAttaching package: %s\n", 
                      sQuote(package)), domain = NA)
                  }
                  msg <- .maskedMsg(same, pkg = sQuote(sp[i]), 
                    by = i < lib.pos)
                  packageStartupMessage(msg, domain = NA)
                }
            }
        }
    }

@statwonk