你可以轻松地在ggplot2的顶部/右侧绘制地毯/斧头吗? [英] Can you easily plot rugs/axes on the top/right in ggplot2?
问题描述
下面的例子没有固有的含义......它只是为了展示标签,地毯等的特定位置,并且代表了(a)我正在研究的一个更大的项目我不能详细讨论,(b)需要使用ggplot,并且(c)需要图形的视觉特征,类似于下面给出的图中所示的图形。
是否有可能使用ggplot2直接重新创建以下内容,或者是使用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))
$($)$ b $($)$ b $($)$($)$ b $ rug(x,side = 3)
rug(y,side = 4)
请参阅解决方案(Chase's,已修改,并且基于Hadley's Geom cod e)在下面发布
接受的解决方案
Chase的答案(已修改)
Chase的答案有几个X和Y不合适,导致顶部/右侧的轴意外浮动。 。
xxx < - function(x,y){
p <-qplot(x,y)+
geom_segment(data = data.frame(x),
aes(x = x,
y = max(y)+ .05,
$ b geom_segment(data = data.frame(x),
$ b $ = $,
yend = max(y)+ .1))+#top-ticks 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))+#右标记
geom_segment(data = data.frame(y) ,
aes(x = max(x)+ .1,
y = min(y),
xend = max(x)+ .1,
yend = max(y ))+#右轴
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) - 0.2),
大小= 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
从哈德利的geom-rug.r,本质上,我通过调整这两个(部分)线条来改变地毯的位置:
$ b
y0 =单位(0,npc),y1 =单位(0.03,npc),
至
y0 =单位(1.02, npc),y1 =单位(1.05,npc),
和
x0 =单位(0,npc),x1 =单位(0.03,npc),
到
x0 =单位(1.02,npc),x1 =单位(1.05,npc),
$ b $
library(ggplot2)
GeomRugAlt< - proto(Geom,{
draw< - function ,数据,比例尺,坐标...){
rugs< - list()
data< - coordinates $ transform(data,scales)
if(!is.nu (数据,段Grob(
x0 =单元(x,本机),x1 =单元(x,本机))的数据(数据$ x)){
rugs $ x <
y0 =单位(1.02,npc),y1 =单位(1.05,npc),
gp = gpar(col = alpha(颜色,alpha),lty =线型,lwd =尺寸* .pt)
))
}
if(!is.null(data $ y)){
rugs $ y < - with(data, (单元(y,native),y1 =单元(y,native),
x0 =单位(1.02,npc),x1 =单位(1.05), npc),
gp = gpar(col = alpha(color,alpha),lty = linetype,lwd = size * .pt)
))
}
gTree(children = do.call(gList,rugs))
}
objname< - rug_alt
desc< - 边缘地毯图
default_stat< - 函数(。)StatIdentity
default_aes< - 函数(。)aes(color =black,size = 0.5,linetype = 1,alpha = 1)
guide_geom< - 函数(。)路径
示例()函数(。){
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()
The following example has no inherent meaning... it's just meant to demonstrate particular 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
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()
这篇关于你可以轻松地在ggplot2的顶部/右侧绘制地毯/斧头吗?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!