XY scatter plot with heatmap strip at margin in r

Question

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?

Answer 1

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))

Answer 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))