你可以轻松地在ggplot2的顶部/右侧绘制地毯/斧头吗? [英] Can you easily plot rugs/axes on the top/right in ggplot2?

查看:217
本文介绍了你可以轻松地在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屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆