[R] 2D filled.contour plot with 1D histograms by axes

[Jim Lemon]

On 03/09/2013 04:05 AM, Jing Lu wrote:
> Hi everyone,
>
> I hope this question is beyond "read the manual". My task is simple, just
> to plot the following, but the plot in the middle should be a
> filled.contour plot:
> http://gallery.r-enthusiasts.com/graph/Scatterplot_with_marginal_histograms_78
>
> Background: I prefer filled.contour rather than hist2d. Because, I could
> use kernel smooth, so the plot for discrete data won't be too ugly. I also
> tried image() and then contour(), but the number on contour is not clear
> and no indication about the color.
>
> My problem: in filled.contour function, it uses layout() for
> filledcontour() plot and rect() plot (color bar). However, I use layout()
> in the outside code to organize 2 histogram and one filled.contour plot.
> Looks like, the layout outside is shadowed by filled.contour(). I am not
> sure how R deal with this problem. Should I rewrite filled.contour()
> somehow?
>
Hi Jing,
I had a look at this and you may have to do the rewrite. Despite 
fiddling with margins and layout, I couldn't get rid of the legend in a 
nice way that would allow the histograms to be plotted. The attached 
code will give just the filled contour, but you will probably have to 
tweak it a bit to get what you want.

Jim

filled.contour.only<-function(x=seq(0,1,length.out=nrow(z)),
  y=seq(0,1,length.out = ncol(z)),z,xlim=range(x,finite=TRUE),
     ylim = range(y, finite = TRUE), zlim = range(z, finite = TRUE),
     levels = pretty(zlim, nlevels), nlevels = 20, color.palette = 
cm.colors,
     col = color.palette(length(levels) - 1), plot.title, plot.axes,
     key.title, key.axes, asp = NA, xaxs = "i", yaxs = "i", las = 1,
     axes = TRUE, frame.plot = axes, ...) {

     if (missing(z)) {
         if (!missing(x)) {
             if (is.list(x)) {
                 z <- x$z
                 y <- x$y
                 x <- x$x
             }
             else {
                 z <- x
                 x <- seq.int(0, 1, length.out = nrow(z))
             }
         }
         else stop("no 'z' matrix specified")
     }
     else if (is.list(x)) {
         y <- x$y
         x <- x$x
     }
     if (any(diff(x) <= 0) || any(diff(y) <= 0))
         stop("increasing 'x' and 'y' values expected")
     mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
     on.exit(par(par.orig))
     w <- (3 + mar.orig[2L]) * par("csi") * 2.54
     par(las = las)
     mar <- mar.orig
     mar[4L] <- mar[2L]
     mar[2L] <- 1
     par(mar = mar)
     mar <- mar.orig
     mar[4L] <- 1
     par(mar = mar)
     plot.new()
     plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
     if (!is.matrix(z) || nrow(z) <= 1L || ncol(z) <= 1L)
         stop("no proper 'z' matrix specified")
     if (!is.double(z))
         storage.mode(z) <- "double"
     .Internal(filledcontour(as.double(x), as.double(y), z, 
as.double(levels),
         col = col))
     if (missing(plot.axes)) {
         if (axes) {
             title(main = "", xlab = "", ylab = "")
             Axis(x, side = 1)
             Axis(y, side = 2)
         }
     }
     else plot.axes
     if (frame.plot)
         box()
     if (missing(plot.title))
         title(...)
     else plot.title
     invisible()
}