简体   繁体   中英

XY scatter plot with heatmap strip at margin in r

Here data and hypithesis:

set.seed(1234)
myd <- data.frame (X = rnorm (100), Y = rnorm (100, 10, 3))

just catorizing X and Y, sometime this may be different variable than X and Y and is category itself

myd$xcat <- cut (myd$X, 10)
myd$ycat <- cut (myd$Y, 10)

I want to make nice plot like the following, where the catories are plotting as strip of heatmap plots 在此输入图像描述

require(ggplot2)
ggplot(myd, aes(x=X, y=Y)) +    geom_point(shape=1)  + theme_bw()

Is this possible ggplot2 or other packages or need a specialized solution?

One way to achieve this is to make three separate plots with ggplot2 and then use viewport() and grid.layout() to arrange them together.

First plot contains just middle part (scatter plot). px and py are heatmaps (made with geom_tile() ) for the x and y axis. Most important part is to use the same theme() settings in plots (just change x to y). Used color="white" for some elements to ensure that there is a place for that element (to have correct dimensions) but they are not visible on plot.

#Scatter plot without axis titles
p<-ggplot(myd, aes(x=X, y=Y)) +    geom_point(shape=1)  + 
  theme_bw() + theme(axis.title=element_blank())

#tile plot for the x axis
px<-ggplot(myd,aes(x=xcat,y=1,fill=xcat))+geom_tile()+
  scale_x_discrete(expand=c(0,0))+
  scale_fill_hue(h=c(0,180))+
  scale_y_continuous(expand=c(0,0),breaks=1,labels="10")+
  theme(legend.position="none",
        axis.title=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.y=element_text(color="white"),
        axis.ticks.y=element_line(color="white"))

#tile plot for the y axis
py<-ggplot(myd,aes(x=1,y=ycat,fill=ycat))+geom_tile()+
  scale_y_discrete(expand=c(0,0))+
  scale_x_continuous(expand=c(0,0),breaks=1,labels="1")+
  scale_fill_hue(h=c(181,360))+
  theme(legend.position="none",
        axis.title=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        axis.text.x=element_text(color="white"),
        axis.ticks.x=element_line(color="white"))

#Define layout for the plots (2 rows, 2 columns)
layt<-grid.layout(nrow=2,ncol=2,heights=c(7/8,1/8),widths=c(1/8,7/8),default.units=c('null','null'))
#View the layout of plots
grid.show.layout(layt)

#Draw plots one by one in their positions
grid.newpage()
pushViewport(viewport(layout=layt))
print(py,vp=viewport(layout.pos.row=1,layout.pos.col=1))
print(p,vp=viewport(layout.pos.row=1,layout.pos.col=2))
print(px,vp=viewport(layout.pos.row=2,layout.pos.col=2))

在此输入图像描述

A solution in base plot:

brX <- seq(min(myd$X),max(myd$X),length=11)
brY <- seq(min(myd$Y),max(myd$Y),length=11)

layout(matrix(c(1,0,2,3),nrow=2),width=c(2,8),height=c(8,2))
par(mar=c(0,3,5,0))
plot(NA,ylim=range(myd$Y),xlim=c(0,1),axes=F,ann=F,xaxs="i")
rect(0,brY[-length(brY)],1,brY[-1], 
     col=colorRampPalette(c("red","yellow","green"))(length(brY)-1))

par(mar=c(0,0,5,5))
plot(NA,xlim=range(myd$X),ylim=range(myd$Y),ann=F,xaxt="n",yaxt="n")
abline(h=pretty(myd$Y),v=pretty(myd$X), col="grey95")
points(myd$X,myd$Y,pch=21)
axis(3)
axis(4)

par(mar=c(3,0,0,5))
plot(NA,xlim=range(myd$X),ylim=c(0,1),axes=F,ann=F,yaxs="i")
rect(brX[-length(brX)],0,brX[-1],1, 
     col=colorRampPalette(c("blue","white","red"))(length(brX)-1))

在此输入图像描述

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM