Wykres rozrzutu z nakładką konturową / cieplną

Widziałem ten wykres w suplemencie do ostatniego artykułu i chciałbym móc go odtworzyć za pomocą R. Jest to wykres rozrzutu, ale aby naprawić nadpisywanie, istnieją linie konturu, które są „ciepłe” od niebieskiego do czerwonego odpowiadające gęstość wykreślania. Jak mam to zrobić?

Oto moje zdanie, używając podstawowych funkcji tylko do rysowania:

library(MASS)  # in case it is not already loaded 
set.seed(101)
n <- 1000
X <- mvrnorm(n, mu=c(.5,2.5), Sigma=matrix(c(1,.6,.6,1), ncol=2))

## some pretty colors
library(RColorBrewer)
k <- 11
my.cols <- rev(brewer.pal(k, "RdYlBu"))

## compute 2D kernel density, see MASS book, pp. 130-131
z <- kde2d(X[,1], X[,2], n=50)

plot(X, xlab="X label", ylab="Y label", pch=19, cex=.4)
contour(z, drawlabels=FALSE, nlevels=k, col=my.cols, add=TRUE)
abline(h=mean(X[,2]), v=mean(X[,1]), lwd=2)
legend("topleft", paste("R=", round(cor(X)[1,2],2)), bty="n")

Aby uzyskać bardziej fantazyjne renderowanie, możesz rzucić okiem na ggplot2 i stat_density2d(). Inną funkcją, którą lubię, jest smoothScatter():

smoothScatter(X, nrpoints=.3*n, colramp=colorRampPalette(my.cols), pch=19, cex=.8)

Nikt nie zaproponował do tego ggplot2?

library(MASS)
library(ggplot2)
n <- 1000
x <- mvrnorm(n, mu=c(.5,2.5), Sigma=matrix(c(1,.6,.6,1), ncol=2))
df = data.frame(x); colnames(df) = c("x","y")

commonTheme = list(labs(color="Density",fill="Density",
                        x="RNA-seq Expression",
                        y="Microarray Expression"),
                   theme_bw(),
                   theme(legend.position=c(0,1),
                         legend.justification=c(0,1)))

ggplot(data=df,aes(x,y)) + 
  geom_density2d(aes(colour=..level..)) + 
  scale_colour_gradient(low="green",high="red") + 
  geom_point() + commonTheme

Co powoduje:

Jednak dość łatwo można zrobić także inne rzeczy, takie jak:

ggplot(data=df,aes(x,y)) + 
  stat_density2d(aes(fill=..level..,alpha=..level..),geom='polygon',colour='black') + 
  scale_fill_continuous(low="green",high="red") +
  geom_smooth(method=lm,linetype=2,colour="red",se=F) + 
  guides(alpha="none") +
  geom_point() + commonTheme

Co powoduje: