Skip to content

Commit 0236669

Browse files
sebkopfsebkopf
committed
Merge pull request #1 from hadley/master
merge master back in
2 parents 485c716 + 193d843 commit 0236669

17 files changed

+308
-50
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: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,18 @@ ggplot2 0.9.3.1.99
6565
* Add `"none"` to documentation of `theme()` for parameter `legend.position`
6666
(@krlmlr, #829).
6767

68+
* The outliers of geom_boxplot() use the default colour, size and shape from
69+
geom_point(). Changing the defaults of geom_point() with
70+
update_geom_defaults() will apply the same changes to the outliers of
71+
geom_boxplot(). Changing the defaults for the outliers was previously not
72+
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)
79+
6880
ggplot2 0.9.3.1
6981
----------------------------------------------------------------
7082

‎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/Uncyclopedia: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"

‎R/geom-boxplot.r

Lines changed: 25 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -23,9 +23,9 @@
2323
#' continuous variable, \code{\link{geom_jitter}} for another way to look
2424
#' at conditional distributions"
2525
#' @inheritParams geom_point
26-
#' @param outlier.colour colour for outlying points
27-
#' @param outlier.shape shape of outlying points
28-
#' @param outlier.size size of outlying points
26+
#' @param outlier.colour colour for outlying points. Uses the default from geom_point().
27+
#' @param outlier.shape shape of outlying points. Uses the default from geom_point().
28+
#' @param outlier.size size of outlying points. Uses the default from geom_point().
2929
#' @param notch if \code{FALSE} (default) make a standard box plot. If
3030
#' \code{TRUE}, make a notched box plot. Notches are used to compare groups;
3131
#' if the notches of two boxes do not overlap, this is strong evidence that
@@ -100,13 +100,30 @@
100100
#' # Using varwidth
101101
#' p + geom_boxplot(varwidth = TRUE)
102102
#' qplot(factor(cyl), mpg, data = mtcars, geom = "boxplot", varwidth = TRUE)
103+
#'
104+
#' # Update the defaults for the outliers by changing the defaults for geom_point
105+
#'
106+
#' p <- ggplot(mtcars, aes(factor(cyl), mpg))
107+
#' p + geom_boxplot()
108+
#'
109+
#' update_geom_defaults("point", list(shape = 1, colour = "red", size = 5))
110+
#' p + geom_boxplot()
103111
#' }
104-
geom_boxplot <- function (mapping = NULL, data = NULL, stat = "boxplot", position = "dodge",
105-
outlier.colour = "black", outlier.shape = 16, outlier.size = 2,
106-
notch = FALSE, notchwidth = .5, varwidth = FALSE, ...) {
112+
geom_boxplot <- function (mapping = NULL, data = NULL, stat = "boxplot",
113+
position = "dodge", outlier.colour = NULL,
114+
outlier.shape = NULL, outlier.size = NULL,
115+
notch = FALSE, notchwidth = .5, ...) {
116+
117+
outlier_defaults <- Geom$find('point')$default_aes()
118+
119+
outlier.colour <- outlier.colour %||% outlier_defaults$colour
120+
outlier.shape <- outlier.shape %||% outlier_defaults$shape
121+
outlier.size <- outlier.size %||% outlier_defaults$size
122+
107123
GeomBoxplot$new(mapping = mapping, data = data, stat = stat,
108-
position = position, outlier.colour = outlier.colour, outlier.shape = outlier.shape,
109-
outlier.size = outlier.size, notch = notch, notchwidth = notchwidth, varwidth = varwidth, ...)
124+
position = position, outlier.colour = outlier.colour,
125+
outlier.shape = outlier.shape, outlier.size = outlier.size, notch = notch,
126+
notchwidth = notchwidth, ...)
110127
}
111128

112129
GeomBoxplot <- proto(Geom, {

‎R/scale-datetime.r

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
#' returns a vector of breaks, or a character vector, specifying the width
88
#' between breaks. For more information about the first two, see
99
#' \code{\link{continuous_scale}}, for more information about the last,
10-
#' see \code{\link[scales]{date_breaks}}`.
10+
#' see \code{\link[scales]{date_breaks}}.
1111
#' @param minor_breaks Either \code{NULL} for no minor breaks, \code{waiver()}
1212
#' for the default breaks (one minor break between each major break), a
1313
#' numeric vector of positions, or a function that given the limits returns

‎R/stat-summary.r

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,11 @@
11
#' Summarise y values at every unique x.
22
#'
33
#' \code{stat_summary} allows for tremendous flexibilty in the specification
4-
#' of summary functions. The summary function can either operate on a data
5-
#' frame (with argument name \code{fun.data}) or on a vector (\code{fun.y},
6-
#' \code{fun.ymax}, \code{fun.ymin}).
4+
#' of summary functions. The summary function can either supply individual
5+
#' summary functions for each of y, ymin and ymax (with \code{fun.y},
6+
#' \code{fun.ymax}, \code{fun.ymin}), or return a data frame containing any
7+
#' number of aesthetiics with with \code{fun.data}. All summary functions
8+
#' are called with a single vector of values, \code{x}.
79
#'
810
#' A simple vector function is easiest to work with as you can return a single
911
#' number, but is somewhat less flexible. If your summary function operates

‎man/geom_boxplot.Rd

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -4,16 +4,15 @@
44
\title{Box and whiskers plot.}
55
\usage{
66
geom_boxplot(mapping = NULL, data = NULL, stat = "boxplot",
7-
position = "dodge", outlier.colour = "black", outlier.shape = 16,
8-
outlier.size = 2, notch = FALSE, notchwidth = 0.5, varwidth = FALSE,
9-
...)
7+
position = "dodge", outlier.colour = NULL, outlier.shape = NULL,
8+
outlier.size = NULL, notch = FALSE, notchwidth = 0.5, ...)
109
}
1110
\arguments{
12-
\item{outlier.colour}{colour for outlying points}
11+
\item{outlier.colour}{colour for outlying points. Uses the default from geom_point().}
1312

14-
\item{outlier.shape}{shape of outlying points}
13+
\item{outlier.shape}{shape of outlying points. Uses the default from geom_point().}
1514

16-
\item{outlier.size}{size of outlying points}
15+
\item{outlier.size}{size of outlying points. Uses the default from geom_point().}
1716

1817
\item{notch}{if \code{FALSE} (default) make a standard box plot. If
1918
\code{TRUE}, make a notched box plot. Notches are used to compare groups;
@@ -126,6 +125,14 @@ b + geom_boxplot(aes(fill = X1), stat = "identity")
126125
# Using varwidth
127126
p + geom_boxplot(varwidth = TRUE)
128127
qplot(factor(cyl), mpg, data = mtcars, geom = "boxplot", varwidth = TRUE)
128+
129+
# Update the defaults for the outliers by changing the defaults for geom_point
130+
131+
p <- ggplot(mtcars, aes(factor(cyl), mpg))
132+
p + geom_boxplot()
133+
134+
update_geom_defaults("point", list(shape = 1, colour = "red", size = 5))
135+
p + geom_boxplot()
129136
}
130137
}
131138
\references{

‎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/Uncyclopedia: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)