Can you easily plot rugs/axes on the top/right in ggplot2?
The following example has no inherent meaning... it's just meant to demonstrate 开发者_如何学Goparticular placement of labels, rugs, etc. and is representative of [edited] (a) a significantly larger project I'm working on that I can't discuss in detail, (b) which requires the use of ggplot, and (c) needs visual features of graphics similar to those reflected in the plot given, below.
Is it possible to recreate the following using ggplot2 either directly or with some fiddling with grid?
x <- rnorm(20)
y <- rnorm(20)
plot(x, y, axes=F, xlab="", ylab="")
axis(side = 1, at = round(mean(x), 2))
axis(side = 2, at = round(mean(y), 2))
axis(side = 3, at = round( range(x), 2 ))
axis(side = 4, at = round( range(y), 2 ))
rug(x, side=3)
rug(y, side=4)
Please see the solutions (Chase's, modified, and one based on Hadley's Geom code) posted below
I'll echo @Gavin's question, but for the sake of fiddling, this should get you pretty close:
qplot(x,y) +
geom_segment(data = data.frame(x), aes(x = x, y = max(x) - .05, xend = x, yend = max(x))) + #x-rug
geom_segment(data = data.frame(x), aes(x = min(x), y = max(x), xend = max(x), yend = max(x))) + #x-rug
geom_segment(data = data.frame(y), aes(x = max(x) + .05, y = y, xend = max(x), yend = y)) + #y-rug
geom_segment(data = data.frame(y), aes(x = max(x) + .05, y = min(y), xend = max(x) + .05, yend = max(y) )) + #y-rug
scale_x_continuous(breaks = NA) +
scale_y_continuous(breaks = NA) +
xlab(NULL) +
ylab(NULL) +
geom_text(aes(label = round(mean(x),2), x = mean(x), y = min(y) - .2), size = 4) +
geom_text(aes(label = round(mean(y),2), x = min(x) - .2, y = mean(y)), size = 4) +
geom_text(aes(label = round(max(x),2), x = max(x) + .2, y = max(y) + .2), size = 4)
#...add other text labels to your heart's desire.
If you don't need to put the rugs on the top and on the right, you can take advantage of geom_rug()
. I don't know of an easy way to "move" the x or y axis away from their predefined locations. Something like this may be easier to digest / work with:
df <- data.frame(x,y)
qplot(x,y, data = df, geom = c("point", "rug")) # + ...any additional geom's here
Accepted Solutions
Chase's Answer (Modified)
Chase's answer had a few Xs and Ys out of place, causing the top/right axes to float unexpectedly... Here's an updated version of it:
xxx <- function(x, y) {
p <- qplot(x,y) +
geom_segment(data = data.frame(x),
aes(x = x,
y = max(y) + .05,
xend = x,
yend = max(y) + .1 )) + #top-ticks
geom_segment(data = data.frame(x),
aes(x = min(x),
y = max(y) + .1,
xend = max(x),
yend = max(y) + .1 )) + #top-axis
geom_segment(data = data.frame(y),
aes(x = max(x) + .1,
y = y,
xend = max(x) + .05,
yend = y)) + #right-ticks
geom_segment(data = data.frame(y),
aes(x = max(x) + .1,
y = min(y),
xend = max(x) + .1,
yend = max(y) )) + #right-axis
scale_x_continuous(breaks = NA) +
scale_y_continuous(breaks = NA) +
xlab(NULL) +
ylab(NULL) +
geom_text(aes(label = round(mean(x), 2),
x = mean(x),
y = min(y) - .2),
size = 4) +
geom_text(aes(label = round(mean(y), 2),
x = min(x) - .2,
y = mean(y)),
size = 4) +
geom_text(aes(label = round(max(y), 2),
x = max(x) + .5,
y = max(y) + .0),
size = 4) + #right-max
geom_text(aes(label = round(min(y), 2),
x = max(x) + .5,
y = min(y) - .0),
size = 4) + #right-min
geom_text(aes(label = round(max(x), 2),
x = max(x) + .0,
y = max(y) + .2),
size = 4) + #top-max
geom_text(aes(label = round(min(x), 2),
x = min(x) + .0,
y = max(y) + .2),
size = 4) #top-min
}
x <- rnorm(20)
y <- rnorm(20)
(xxx(x, y))
Solution Based on Hadley's Code
See: https://github.com/hadley/ggplot2/wiki/Creating-a-new-geom
Beginning with Hadley's geom-rug.r, essentially, I've changed only the location of the rugs by tweaking these two (partial) lines:
From
y0 = unit(0, "npc"), y1 = unit(0.03, "npc"),
to
y0 = unit(1.02, "npc"), y1 = unit(1.05, "npc"),
and from
x0 = unit(0, "npc"), x1 = unit(0.03, "npc"),
to
x0 = unit(1.02, "npc"), x1 = unit(1.05, "npc"),
library(ggplot2)
GeomRugAlt <- proto(Geom, {
draw <- function(., data, scales, coordinates, ...) {
rugs <- list()
data <- coordinates$transform(data, scales)
if (!is.null(data$x)) {
rugs$x <- with(data, segmentsGrob(
x0 = unit(x, "native"), x1 = unit(x, "native"),
y0 = unit(1.02, "npc"), y1 = unit(1.05, "npc"),
gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
))
}
if (!is.null(data$y)) {
rugs$y <- with(data, segmentsGrob(
y0 = unit(y, "native"), y1 = unit(y, "native"),
x0 = unit(1.02, "npc"), x1 = unit(1.05), "npc"),
gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
))
}
gTree(children = do.call("gList", rugs))
}
objname <- "rug_alt"
desc <- "Marginal rug plots"
default_stat <- function(.) StatIdentity
default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = 1)
guide_geom <- function(.) "path"
examples <- function(.) {
p <- ggplot(mtcars, aes(x=wt, y=mpg))
p + geom_point()
p + geom_point() + geom_rug_alt()
p + geom_point() + geom_rug_alt(position='jitter')
}
})
geom_rug_alt <- GeomRugAlt$build_accessor()
x <- rnorm(20)
y <- rnorm(20)
p <- qplot(x,y)
p
p + geom_rug() + geom_rug_alt()
精彩评论