以下示例没有固有的含义......它只是为了展示标签，地毯等的特定位置，并且代表[编辑] （a）我正在研究的一个更大的项目我不能详细讨论，（b）需要使用ggplot，（c）需要图形的视觉特征，类似于下面给出的图中反映的那些。
是否可以直接使用ggplot2重新创建以下内容，或者使用网格摆弄一些？
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)
答案 0 :(得分：7)
我会回答@Gavin的问题，但为了摆弄，这应该会让你非常接近：
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.
如果您不需要将地毯放在顶部和右侧，您可以利用geom_rug()。我不知道将x或y轴“移动”离开预定位置的简单方法。这样的事情可能更容易消化/使用：
df <- data.frame(x,y)
qplot(x,y, data = df, geom = c("point", "rug")) # + ...any additional geom's here
答案 1 :(得分：4)
Chase的答案有一些X和Y不合适，导致顶/右轴意外浮动......这是它的更新版本：
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))
请参阅：https://github.com/hadley/ggplot2/wiki/Creating-a-new-geom
从Hadley的geom-rug.r开始，基本上，我只是通过调整这两条（部分）线来改变地毯的位置：
这
y0 = unit(0, "npc"), y1 = unit(0.03, "npc"),
到
y0 = unit(1.02, "npc"), y1 = unit(1.05, "npc"),
和
x0 = unit(0, "npc"), x1 = unit(0.03, "npc"),
到
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()