Skip to content

Commit

Permalink
remove style parameters. now styles are set via theme. also add a fun…
Browse files Browse the repository at this point in the history 
…ction of partial update of theme elements - update_element in R/theme.r
  • Loading branch information
@kohske
kohske committed Jul 19, 2011
1 parent 5931a6b commit 002e510
Show file tree
Hide file tree
Showing 3 changed files with 77 additions and 94 deletions.
59 changes: 11 additions & 48 deletions R/guide-colorbar.r
View file
Expand Up @@ -12,15 +12,9 @@
##' @title Colorbar guide
##' @param title A character string or expression indicating a title of guide. If \code{NULL}, the title is not shown. By default (\code{\link{waiver()}}), the name of the scale object or tha name specified in \code{\link{labs}} is used for the title.
##' @param title.position A character string indicating the position of a title. One of "top" (default for a vertical guide), "bottom", "left" (default for a horizontal guide), or "right."
##' @param title.angle The angle to rotate the title text.
##' @param title.hjust A numeric specifying horizontal justification of the title text.
##' @param title.vjust A numeric specifying vertical justification of the title text.
##' @param title.theme A theme object for rendering the title text. Usually the object of \code{\link{theme_text}} is expected. By default, the theme is specified by \code{legend.title} in \code{\link{opts}} or theme.
##' @param label logical. If \code{TRUE} then the labels are drawn. If \code{FALSE} then the labels are invisible.
##' @param label.position A character string indicating the position of a label. One of "top", "bottom" (default for horizontal guide), "left", or "right" (default for vertical gudie).
##' @param label.angle The angle to rotate the label text.
##' @param label.hjust A numeric specifying horizontal justification of the label text.
##' @param label.vjust A numeric specifying vertical justification of the label text.
##' @param label.theme A theme object for rendering the label text. Usually the object of \code{\link{theme_text}} is expected. By default, the theme is specified by \code{legend.text} in \code{\link{opts}} or theme.
##' @param barwidth A numeric or a unit object specifying the width of the colorbar. Default value is \code{legend.key.width} or \code{legend.key.size} in \code{\link{opts}} or theme.
##' @param barheight A numeric or a unit object specifying the height of the colorbar. Default value is \code{legend.key.height} or \code{legend.key.size} in \code{\link{opts}} or theme.
Expand Down Expand Up @@ -90,17 +84,11 @@ guide_colorbar <- function(
##　title
title = waiver(),
title.position = NULL,
title.angle = NULL,
title.hjust = NULL,
title.vjust = NULL,
title.theme = NULL,

## label
label = TRUE,
label.position = NULL,
label.angle = NULL,
label.hjust = NULL,
label.vjust = NULL,
label.theme = NULL,

## bar
Expand All @@ -127,17 +115,11 @@ guide_colorbar <- function(
##　title
title = title,
title.position = title.position,
title.angle = title.angle,
title.hjust = title.hjust,
title.vjust = title.vjust,
title.theme = title.theme,

## label
label = label,
label.position = label.position,
label.angle = label.angle,
label.hjust = label.hjust,
label.vjust = label.vjust,
label.theme = label.theme,

## bar
Expand Down Expand Up @@ -242,20 +224,12 @@ guide_gengrob.colorbar <- function(guide, theme) {

## title
## hjust of title should depend on title.position
title.hjust <- title.x <- guide$title.hjust %||% theme$legend.title.align %||% 0
title.vjust <- title.y <- guide$title.vjust %||% 0.5
title.theme <- guide$title.theme %||% theme$legend.title
grob.title <- {
g <-
if (is.null(guide$title))
zeroGrob()
else if(!is.null(guide$title.theme))
guide$title.theme(label=guide$title, name=grobName(NULL, "guide.title"),
hjust = title.hjust, vjust = title.vjust, x = title.x, y = title.y)
else
theme_render(theme, "legend.title", guide$title,
hjust = title.hjust, vjust = title.vjust, x = title.x, y = title.y)
if (!is.null(guide$title.angle)) g <- editGrob(g, rot = guide$title.angle)
g
if (is.null(guide$title))
zeroGrob()
else
title.theme(label=guide$title, name=grobName(NULL, "guide.title"))
}

title_width <- convertWidth(grobWidth(grob.title), "mm")
Expand All @@ -264,24 +238,13 @@ guide_gengrob.colorbar <- function(guide, theme) {
title_height.c <- c(title_height)

## label
label.theme <- guide$label.theme %||% theme$legend.text
grob.label <- {
if (!guide$label) zeroGrob()
else {
## label hjust: default is center for horizontal and left for vertical colorbar.
hjust <- x <- guide$label.hjust %||%
theme$legend.text.align %||%
if (any(is.expression(guide$key$.label))) 1
else switch(guide$direction, horizontal = 0.5, vertical = 0)
vjust <- y <- guide$label.vjust %||% 0.5
switch(guide$direction, horizontal = {x <- label_pos; y <- vjust}, "vertical" = {x <- hjust; y <- label_pos})
g <-
if(!is.null(guide$label.theme))
guide$label.theme(label=guide$key$.label, x = x, y = y, hjust = hjust, vjust = vjust, name = grobName(NULL, "guide.label"))
else
theme_render(theme, "legend.text", guide$key$.label, x = x, y = y, hjust = hjust, vjust = vjust)
if (!is.null(guide$label.angle)) g <- editGrob(g, rot = guide$label.angle)
g
}
if (!guide$label)
zeroGrob()
else
switch(guide$direction, horizontal = {x <- label_pos; y <- 0.5}, "vertical" = {x <- 0.5; y <- label_pos})
label.theme(label=guide$key$.label, x = x, y = y, name = grobName(NULL, "guide.label"))
}

label_width <- convertWidth(grobWidth(grob.label), "mm")
Expand Down
58 changes: 12 additions & 46 deletions R/guide-legend.r
View file
Expand Up @@ -11,15 +11,9 @@
##' @title Legend guide
##' @param title A character string or expression indicating a title of guide. If \code{NULL}, the title is not shown. By default (\code{\link{waiver()}}), the name of the scale object or tha name specified in \code{\link{labs}} is used for the title.
##' @param title.position A character string indicating the position of a title. One of "top" (default for a vertical guide), "bottom", "left" (default for a horizontal guide), or "right."
##' @param title.angle The angle to rotate the title text.
##' @param title.hjust A numeric specifying horizontal justification of the title text.
##' @param title.vjust A numeric specifying vertical justification of the title text.
##' @param title.theme A theme object for rendering the title text. Usually the object of \code{\link{theme_text}} is expected. By default, the theme is specified by \code{legend.title} in \code{\link{opts}} or theme.
##' @param label logical. If \code{TRUE} then the labels are drawn. If \code{FALSE} then the labels are invisible.
##' @param label.position A character string indicating the position of a label. One of "top", "bottom", "left", or "right" (default).
##' @param label.angle The angle to rotate the label text.
##' @param label.hjust A numeric specifying horizontal justification of the label text.
##' @param label.vjust A numeric specifying vertical justification of the label text.
##' @param label.theme A theme object for rendering the label text. Usually the object of \code{\link{theme_text}} is expected. By default, the theme is specified by \code{legend.text} in \code{\link{opts}} or theme.
##' @param keywidth A numeric or a unit object specifying the width of the legend key. Default value is \code{legend.key.width} or \code{legend.key.size} in \code{\link{opts}} or theme.
##' @param keyheight A numeric or a unit object specifying the height of the legend key. Default value is \code{legend.key.height} or \code{legend.key.size} in \code{\link{opts}} or theme.
Expand Down Expand Up @@ -96,17 +90,11 @@ guide_legend <- function(
##　title
title = waiver(),
title.position = NULL,
title.angle = NULL,
title.hjust = NULL,
title.vjust = NULL,
title.theme = NULL,

## label
label = TRUE,
label.position = NULL,
label.angle = NULL,
label.hjust = NULL,
label.vjust = NULL,
label.theme = NULL,

## key
Expand All @@ -127,17 +115,11 @@ guide_legend <- function(
##　title
title = title,
title.position = title.position,
title.angle = title.angle,
title.hjust = title.hjust,
title.vjust = title.vjust,
title.theme = title.theme,

## label
label = label,
label.position = label.position,
label.angle = label.angle,
label.hjust = label.hjust,
label.vjust = label.vjust,
label.theme = label.theme,

## size of key
Expand Down Expand Up @@ -245,20 +227,12 @@ guide_gengrob.legend <- function(guide, theme) {
vgap <- hgap

## title
title.hjust <- title.x <- guide$title.hjust %||% theme$legend.title.align %||% 0
title.vjust <- title.y <- guide$title.vjust %||% 0.5
title.theme <- guide$title.theme %||% theme$legend.title
grob.title <- {
g <-
if (is.null(guide$title))
zeroGrob()
else if(!is.null(guide$title.theme))
guide$title.theme(label=guide$title, name=grobName(NULL, "guide.title"),
hjust = title.hjust, vjust = title.vjust, x = title.x, y = title.y)
else
theme_render(theme, "legend.title", guide$title,
hjust = title.hjust, vjust = title.vjust, x = title.x, y = title.y)
if (!is.null(guide$title.angle)) g <- editGrob(g, rot = guide$title.angle)
g
if (is.null(guide$title))
zeroGrob()
else
title.theme(label=guide$title, name=grobName(NULL, "guide.title"))
}

title_width <- convertWidth(grobWidth(grob.title), "mm")
Expand All @@ -275,21 +249,13 @@ guide_gengrob.legend <- function(guide, theme) {
## Default:
## If label includes expression, the label is right-alignd (hjust = 0). Ohterwise, left-aligned (x = 1, hjust = 1).
## Vertical adjustment is always mid-alined (vjust = 0.5).
grob.labels <-
if (!guide$label) zeroGrob()
else {
hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||% if (any(is.expression(guide$key$.label))) 1 else 0
vjust <- y <- guide$label.vjust %||% 0.5
lapply(guide$key$.label, function(label){
g <-
if(!is.null(guide$label.theme))
guide$label.theme(label=label, name=grobName(NULL, "guide.label"), x = x, y = y, hjust = hjust, vjust = vjust)
else
theme_render(theme, "legend.text", label, x = x, y = y, hjust = hjust, vjust = vjust)
if (!is.null(guide$label.angle)) g <- editGrob(g, rot = guide$label.angle)
g
})
}
label.theme <- guide$label.theme %||% theme$legend.text
grob.labels <- {
if (!guide$label)
zeroGrob()
else
lapply(guide$key$.label, function(label) label.theme(label=label, name=grobName(NULL, "guide.label")))
}

label_widths <- lapply(grob.labels, function(g)convertWidth(grobWidth(g), "mm"))
label_heights <- lapply(grob.labels, function(g)convertHeight(grobHeight(g), "mm"))
Expand Down
54 changes: 54 additions & 0 deletions R/theme.r
View file
Expand Up @@ -208,3 +208,57 @@ print.theme <- function(x, ...) {
plot_theme <- function(x) {
defaults(x$options, theme_get())
}

##' Update contents of a theme
##'
##' @title Update theme param
##' @param name name of a theme element
##' @param ... Pairs of name and value of theme parameters.
##' @return Updated theme element
##' @export
##' @example
##' x <- theme_text(size = 15)
##' update_element(x, colour = "red")
##' # Partial matching works
##' update_element(x, col = "red")
##' # So does positional
##' update_element(x, "Times New Roman")
##' # And it throws an error if you use an argument that doesn't exist
##' update_element(x, noargument = 12)
##' # Or multiple arguments with the same name
##' update_element(x, size = 12, size = 15)
##'
##' # Will look up element if given name
##' update_element("axis.text.x", colour = 20)
##' # Throws error if incorrectly named
##' update_element("axis.text", colour = 20)
update_element <- function(name, ...) {
if (is.character(name)) {
ele <- theme_get()[[name]]
if (is.null(ele)) {
stop("Could not find theme element ", name, call. = FALSE)
}
} else {
ele <- name
}

call <- attr(ele, "call")
stopifnot(!is.null(call))

# Partial matching of named ... args with full names
f <- eval(call[[1]])
new_args <- match.call()
new_args$name <- NULL
new_args <- as.list(match.call(f, new_args)[-1])

# Combine old call with new args
old <- as.list(call)

# evaluate old args in its env
evaled_old_args <- llply(names(old[-1]), get, environment(ele))
names(evaled_old_args) <- names(old[-1])
# replace premise with evaluated vars
old <- modifyList(old, evaled_old_args)

eval(as.call(modifyList(old, new_args)))
}

0 comments on commit 002e510

Please sign in to comment.