Skip to content

Commit 193d843

Browse files
hadleyhadley
committed
New labeller functions from @stefanedwards.
Squashed from #910
1 parent 1cdf233 commit 193d843

File tree

5 files changed

+229
-0
lines changed

5 files changed

+229
-0
lines changed

‎NAMESPACE

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -275,6 +275,8 @@ export(label_both)
275275
export(label_bquote)
276276
export(label_parsed)
277277
export(label_value)
278+
export(label_wrap_gen)
279+
export(labeller)
278280
export(labs)
279281
export(last_plot)
280282
export(layer)

‎NEWS

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -70,6 +70,12 @@ ggplot2 0.9.3.1.99
7070
update_geom_defaults() will apply the same changes to the outliers of
7171
geom_boxplot(). Changing the defaults for the outliers was previously not
7272
possible. (@ThierryO, #757)
73+
* Added helper function `labeller` for formatting faceting values.
74+
(@stefanedwards, #910)
75+
76+
* Added `label_wrap_gen` based on
77+
https://github.com/hadley/ggplot2/wiki/labeller#writing-new-labellers
78+
(@stefanedwards, #910)
7379

7480
ggplot2 0.9.3.1
7581
----------------------------------------------------------------

‎R/facet-labels.r

Lines changed: 122 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,128 @@ label_bquote <- function(expr = beta ^ .(x)) {
6262
}
6363
}
6464

65+
#' Label facets with a word wrapped label.
66+
#'
67+
#' Uses \code{\link[base]{strwrap}} for line wrapping.
68+
#' @param width integer, target column width for output.
69+
#' @export
70+
#' @seealso , \code{\link{labeller}}
71+
label_wrap_gen <- function(width = 25) {
72+
function(variable, values) {
73+
vapply(strwrap(as.character(values), width = width, simplify = FALSE),
74+
paste, vector('character', 1), collapse = "\n")
75+
}
76+
}
77+
78+
#' Generic labeller function for facets
79+
#'
80+
#' One-step function for providing methods or named character vectors
81+
#' for displaying labels in facets.
82+
#'
83+
#' The provided methods are checked for number of arguments.
84+
#' If the provided method takes less than two
85+
#' (e.g. \code{\link[Hmisc]{capitalize}}),
86+
#' the method is passed \code{values}.
87+
#' Else (e.g. \code{\link{label_both}}),
88+
#' it is passed \code{variable} and \code{values} (in that order).
89+
#' If you want to be certain, use e.g. an anonymous function.
90+
#' If errors are returned such as ``argument ".." is missing, with no default''
91+
#' or ``unused argument (variable)'', matching the method's arguments does not
92+
#' work as expected; make a wrapper function.
93+
#'
94+
#'
95+
#' @param ... Named arguments of the form \code{variable=values},
96+
#' where \code{values} could be a vector or method.
97+
#' @param keep.as.numeric logical, default TRUE. When FALSE, converts numeric
98+
#' values supplied as margins to the facet to characters.
99+
#' @family facet labeller
100+
#' @return Function to supply to
101+
#' \code{\link{facet_grid}} for the argument \code{labeller}.
102+
#' @export
103+
#' @examples
104+
#'
105+
#' data(mpg)
106+
#'
107+
#' p1 <- ggplot(mpg, aes(cty, hwy)) + geom_point()
108+
#'
109+
#'
110+
#' p1 + facet_grid(cyl ~ class, labeller=label_both)
111+
#'
112+
#' p1 + facet_grid(cyl ~ class, labeller=labeller(cyl=label_both))
113+
#'
114+
#' ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point() +
115+
#' facet_grid(vs + am ~ gear, margins=TRUE,
116+
#' labeller=labeller(vs=label_both, am=label_both))
117+
#'
118+
#'
119+
#'
120+
#' data(msleep)
121+
#' capitalize <- function(string) {
122+
#' substr(string, 1, 1) <- toupper(substr(string, 1, 1))
123+
#' string
124+
#' }
125+
#' conservation_status <- c('cd'='Conservation Dependent',
126+
#' 'en'='Endangered',
127+
#' 'lc'='Least concern',
128+
#' 'nt'='Near Threatened',
129+
#' 'vu'='Vulnerable',
130+
#' 'domesticated'='Domesticated')
131+
#' ## Source: http://en.wikipedia.org/wiki/Wikipedia:Conservation_status
132+
#'
133+
#' p2 <- ggplot(msleep, aes(x=sleep_total, y=awake)) + geom_point() +
134+
#' p2 + facet_grid(vore ~ conservation, labeller=labeller(vore=capitalize))
135+
#'
136+
#' p2 + facet_grid(vore ~ conservation,
137+
#' labeller=labeller(vore=capitalize, conservation=conservation_status ))
138+
#'
139+
#' # We could of course have renamed the levels;
140+
#' # then we can apply another nifty function:
141+
#' library(plyr)
142+
#' msleep$conservation2 <- revalue(msleep$conservation, conservation_status)
143+
#'
144+
#' p2 + facet_grid(vore ~ conservation2, labeller=labeller(vore=capitalize))
145+
#'
146+
#' p2 + facet_grid(vore ~ conservation2,
147+
#' labeller=labeller(conservation2=label_wrap_gen(10) ))
148+
#'
149+
labeller <- function(..., keep.as.numeric=FALSE) {
150+
args <- list(...)
151+
152+
function(variable, values) {
153+
if (is.logical(values)) {
154+
values <- as.integer(values) + 1
155+
} else if (is.factor(values)) {
156+
values <- as.character(values)
157+
} else if (is.numeric(values) & !keep.as.numeric) {
158+
values <- as.character(values)
159+
}
160+
161+
res <- args[[variable]]
162+
163+
if (is.null(res)) {
164+
# If the facetting margin (i.e. `variable`) was not specified when calling
165+
# labeller, default to use the actual values.
166+
result <- values
167+
168+
} else if (is.function(res)) {
169+
# How should `variable` and `values` be passed to a function? ------------
170+
arguments <- length(formals(res))
171+
if (arguments < 2) {
172+
result <- res(values)
173+
} else {
174+
result <- res(variable, values)
175+
}
176+
177+
} else {
178+
result <- res[values]
179+
}
180+
181+
return(result)
182+
}
183+
}
184+
185+
186+
65187
# Grob for strip labels
66188
ggstrip <- function(text, horizontal=TRUE, theme) {
67189
text_theme <- if (horizontal) "strip.text.x" else "strip.text.y"

‎man/label_wrap_gen.Rd

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
% Generated by roxygen2 (4.0.0): do not edit by hand
2+
\name{label_wrap_gen}
3+
\alias{label_wrap_gen}
4+
\title{Label facets with a word wrapped label.}
5+
\usage{
6+
label_wrap_gen(width = 25)
7+
}
8+
\arguments{
9+
\item{width}{integer, target column width for output.}
10+
}
11+
\description{
12+
Uses \code{\link[base]{strwrap}} for line wrapping.
13+
}
14+
\seealso{
15+
, \code{\link{labeller}}
16+
}
17+

‎man/labeller.Rd

Lines changed: 82 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,82 @@
1+
% Generated by roxygen2 (4.0.0): do not edit by hand
2+
\name{labeller}
3+
\alias{labeller}
4+
\title{Generic labeller function for facets}
5+
\usage{
6+
labeller(..., keep.as.numeric = FALSE)
7+
}
8+
\arguments{
9+
\item{...}{Named arguments of the form
10+
\code{variable=values}, where \code{values} could be a
11+
vector or method.}
12+
13+
\item{keep.as.numeric}{logical, default TRUE. When FALSE,
14+
converts numeric values supplied as margins to the facet
15+
to characters.}
16+
}
17+
\value{
18+
Function to supply to
19+
\code{\link{facet_grid}} for the argument \code{labeller}.
20+
}
21+
\description{
22+
One-step function for providing methods or named character vectors
23+
for displaying labels in facets.
24+
}
25+
\details{
26+
The provided methods are checked for number of arguments.
27+
If the provided method takes less than two
28+
(e.g. \code{\link[Hmisc]{capitalize}}),
29+
the method is passed \code{values}.
30+
Else (e.g. \code{\link{label_both}}),
31+
it is passed \code{variable} and \code{values} (in that order).
32+
If you want to be certain, use e.g. an anonymous function.
33+
If errors are returned such as ``argument ".." is missing, with no default''
34+
or ``unused argument (variable)'', matching the method's arguments does not
35+
work as expected; make a wrapper function.
36+
}
37+
\examples{
38+
data(mpg)
39+
40+
p1 <- ggplot(mpg, aes(cty, hwy)) + geom_point()
41+
42+
43+
p1 + facet_grid(cyl ~ class, labeller=label_both)
44+
45+
p1 + facet_grid(cyl ~ class, labeller=labeller(cyl=label_both))
46+
47+
ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point() +
48+
facet_grid(vs + am ~ gear, margins=TRUE,
49+
labeller=labeller(vs=label_both, am=label_both))
50+
51+
52+
53+
data(msleep)
54+
capitalize <- function(string) {
55+
substr(string, 1, 1) <- toupper(substr(string, 1, 1))
56+
string
57+
}
58+
conservation_status <- c('cd'='Conservation Dependent',
59+
'en'='Endangered',
60+
'lc'='Least concern',
61+
'nt'='Near Threatened',
62+
'vu'='Vulnerable',
63+
'domesticated'='Domesticated')
64+
## Source: http://en.wikipedia.org/wiki/Wikipedia:Conservation_status
65+
66+
p2 <- ggplot(msleep, aes(x=sleep_total, y=awake)) + geom_point() +
67+
p2 + facet_grid(vore ~ conservation, labeller=labeller(vore=capitalize))
68+
69+
p2 + facet_grid(vore ~ conservation,
70+
labeller=labeller(vore=capitalize, conservation=conservation_status ))
71+
72+
# We could of course have renamed the levels;
73+
# then we can apply another nifty function:
74+
library(plyr)
75+
msleep$conservation2 <- revalue(msleep$conservation, conservation_status)
76+
77+
p2 + facet_grid(vore ~ conservation2, labeller=labeller(vore=capitalize))
78+
79+
p2 + facet_grid(vore ~ conservation2,
80+
labeller=labeller(conservation2=label_wrap_gen(10) ))
81+
}
82+

0 commit comments

Comments
 (0)