.Rprofile

# Rprofile.site file

.First <- function() {
    #.libPaths(c("~/lib/R/3.0", .libPaths()))
    if (Sys.getenv("TERM") == "xterm-256color") {
        library("colorout")
    }
}

.Last <- function() {
    cat("\nGoodbye at ", date(), "\n", file=stderr())
}

# Short custom functions
getDate <- function(sec = FALSE) {
    if (sec) {
        date <- format(Sys.time(), "%Y-%m-%d-%H%M%S")
    }
    else {
        date <- format(Sys.time(), "%Y-%m-%d-%H%M")
    }
    return(date)
}

# improved list of objects
# http://stackoverflow.com/questions/1358003/tricks-to-manage-the-available-memory-in-an-r-session
.ls.objects <- function (pos = 1, pattern, order.by,
                        decreasing=FALSE, head=FALSE, n=5) {
    napply <- function(names, fn) sapply(names, function(x)
                                         fn(get(x, pos = pos)))
    names <- ls(pos = pos, pattern = pattern)
    obj.class <- napply(names, function(x) as.character(class(x))[1])
    obj.mode <- napply(names, mode)
    obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class)
    obj.prettysize <- napply(names, function(x) {
                           capture.output(print(object.size(x), units = "auto")) })
    obj.size <- napply(names, object.size)
    obj.dim <- t(napply(names, function(x)
                        as.numeric(dim(x))[1:2]))
    vec <- is.na(obj.dim)[, 1] & (obj.type != "function")
    obj.dim[vec, 1] <- napply(names, length)[vec]
    out <- data.frame(obj.type, obj.size, obj.prettysize, obj.dim)
    names(out) <- c("Type", "Size", "PrettySize", "Rows", "Columns")
    if (!missing(order.by))
        out <- out[order(out[[order.by]], decreasing=decreasing), ]
    if (head)
        out <- head(out, n)
    out
}

# shorthand
lsos <- function(..., n=10) {
    .ls.objects(..., order.by="Size", decreasing=TRUE, head=TRUE, n=n)
}

hhead <- function(x, ncol = 10, n=10, ...) {
    # Modified version of head() that makes larger data.frame/matrix more
    # visible if there are too many columns
    d <- dim(x)
    if (is.null(d)) {   # if not a data.frame/matrix
        head(x, n=n, ...)
    }
    else {
        head(x[,1:min(d[2],ncol)], n=n, ...)
    }
}

display.colors <- function(c, ...) {
    n <- length(c)
    barplot(rep(1, n), col = c, names = c, yaxt="n", ...)
}

cbPalette <- function() {
    return(c("#000000", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7"))
}