Skip to content

Instantly share code, notes, and snippets.

@leeper
Last active Oct 28, 2016
Embed
What would you like to do?
Experimenting with themes in base graphics
#' 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,...){
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment