Experimenting with themes in base graphics

plotthemes.R

#' The goals here are to:
#' (1) play around with themes to make base graphics less ugly
#' (2) atomically specify multiple plot aspects (data, axes, grid, title) in a single call
#' (3) Recycle last plot theme to easily duplicate its appearance in the next plot
#' The idea is to create a set of customizable functions like `theme()`, which return a list of graphics arguments
#' These can then be passed to `splot`, which will cleanly handle them by passing some to `par` and some to `plot`
#' Different `theme()` functions can then be used to modify color palettes, axes, etc.

merge.list <-
function (x, y) {
    # original function from RCurl::merge.list
    if(length(x) == 0)
        return(y)
    if(length(y) == 0) 
        return(x)
    i <- match(names(y), names(x))
    i <- is.na(i)
    if(any(i)) 
        x[names(y)[which(i)]] <- y[which(i)]
    return(x)
}

# environment to store themes
themeEnv <- new.env()

.emptyTheme <- function(){
    # return a named list containing all theme parameters, without values
}


defaultTheme <- function(){
    args <- .emptyTheme()
    # need code here to populate default values
    out <- newTheme('defaultTheme', template=NULL, args)
    return(out)
}

theme <- function(){
    if(!exists(themeEnv$lastTheme) || is.null(themeEnv$lastTheme))
        return(themeEnv$lastTheme)
    else
        return(defaultTheme())
}

newTheme <-
function(name, template=NULL, ...){
    args <- list(...) # this should contain any plotting arguments to replace in the template
    if(!is.null(template)){
        if(!inherits(template,'theme'))
            stop("'template' is not of class 'theme'")
        theme <- merge.list(template, args)
    } else
        theme <- merge.list(.emptyTheme(), args)
    assign(theme, name, envir=themeEnv)
    return(theme)
}

p <-
function(fun=plot, ..., theme=theme()){
    # simple plot to wrap plotting functions but call various theme
    
    if(is.null(theme))
        stop("No 'theme' specified")
    
    args <- list(...)
    f <- names(formals(fun))
    fun_args <- args[names(args) %in% f]
    other_args <- args[!names(args) %in% f]
    
    theme <- merge.list(theme, other_args)
    class(theme) <- 'theme'
    
    # parse args from `theme()`, separating `par()` args from atomic args to different plotting functions
    # then call them respectively
    
    # conditionally call `xy.coords` if `x` and `y` are specified
    xj <- jitter(x, x_jitter_amount)
    yj <- jitter(y, y_jitter_amount)
    coords <- xy.coord(xj,yj)
    
    xlim <-
    if (is.null(xlim)) 
        range(xy$x[is.finite(xy$x)])
    else
        xlim
    ylim <-
    if (is.null(ylim)) 
        range(xy$y[is.finite(xy$y)])
    else
        ylim
    
    par()
    plot.new() # called empty to create new plot
    # `xaxs` and `yaxs` (values 'r' default or 'i') control extra space on axes
    plot.window(xlim, ylim, log, asp, xaxs, yaxs)
    box() # box?
    
    # grid as calls to `abline` (vectorized)
    # grid should be based on ticks
    # abline(h=...)
    # abline(v=...)

    do.call('plot.xy', list(coords, arglist))
    do.call('axis', 1, arglist)
    do.call('axis', 2, arglist)
    do.call('axis', 3, arglist)
    do.call('axis', 4, arglist)
    
    if(rug)
        do.call('rug', arglist)
    if(!is.null(title))
        do.call('title', arglist)
    
    #do.call('points', arglist)
    
    # save theme "on deck"
    themeEnv$lastTheme <- theme
    
    # return theme
    out <- list(theme=theme,
                fun=fun,
                args=fun_args)
    class(out) <- "splot"
    return(invisible(out))
}

print.splot <- function(x,...){
}

print.theme <- function(x,...){
}