Multiple Contour Plots in R

Question

I have a problem when implementing the codes from here. The error message was as follows.

Error in .Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), : there is no .Internal function 'filledcontour'

All I did was copy and paste the three files together, namely, filled.contour3.R, filled.legend.R and Example 4 panel contour plot with one legend.R from here.

  filled.contour3 <- 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,mar, ...) 
  {
    # modification by Ian Taylor of the filled.contour function
    # to remove the key and facilitate overplotting with contour()
    # further modified by Carey McGilliard and Bridget Ferris
    # to allow multiple plots on one page

    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[2]) * par("csi") * 2.54
    # par(las = las)
    # mar <- mar.orig
    plot.new()
    # par(mar=mar)
    plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
    if (!is.matrix(z) || nrow(z) <= 1 || ncol(z) <= 1) 
      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()
  }

  filled.legend <- 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, ...) 
   {
    # modification of filled.contour by Carey McGilliard and Bridget Ferris
    # designed to just plot the legend
    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
    #layout(matrix(c(2, 1), ncol = 2L), widths = c(1, lcm(w)))
    #  par(las = las)
    #  mar <- mar.orig
    #  mar[4L] <- mar[2L]
    #  mar[2L] <- 1
    #  par(mar = mar)
    # plot.new()
    plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i", 
                yaxs = "i")
    rect(0, levels[-length(levels)], 1, levels[-1L], col = col)
    if (missing(key.axes)) {
      if (axes) 
        axis(4)
    }
    else key.axes
    box()
  }
#
#    if (!missing(key.title)) 
#        key.title
#    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()
#}



  MakeLetter <- function(a, where="topleft", cex=2)
  legend(where, pt.cex=0, bty="n", title=a, cex=cex, legend=NA)

#------------------------------------------------------
#Generate some fake data
x = rep(c(10,11,12),length = 9)
y = rep(c(1,2,3),each = 3)
z = runif(n=9,min = 0,max = 1)


xcoords = unique(x)
ycoords = unique(y)
surface.matrix = matrix(z,nrow=length(xcoords),ncol=length(ycoords),byrow=T)
#------------------------------------------------------

#plot.new() is necessary if using the modified versions of filled.contour
plot.new()

#I am organizing where the plots appear on the page using the "plt" argument in "par()"
par(new = "TRUE",plt = c(0.1,0.4,0.60,0.95),las = 1,cex.axis = 1)

#Top left plot:
filled.contour3(xcoords,ycoords,surface.matrix,color=terrain.colors,xlab = "",ylab = "",xlim = c(min(xcoords),max(xcoords)),ylim = c(min(ycoords),max(ycoords)),zlim = c(min(surface.matrix),max(surface.matrix)))
#The xpd=NA allows for writing outside the plot limits, but still using the the x and y axes to place the text
par(xpd = NA)
text(x=11,y=1.5,"x",cex = 1.5,font = 2)
MakeLetter("(a)")

#Top right plot:
par(new = "TRUE",plt = c(0.5,0.8,0.60,0.95),las = 1,cex.axis = 1)
filled.contour3(xcoords,ycoords,surface.matrix,color=heat.colors,xlab = "",ylab = "",xlim = c(min(xcoords),max(xcoords)),ylim = c(min(ycoords),max(ycoords)),zlim = c(-1,1))
#Alternatively, you could set z axis limits to depend on the min and max values in surface.matrix.
#filled.contour3(xcoords,ycoords,surface.matrix,color=heat.colors,xlab = "",ylab = "",xlim = c(min(xcoords),max(xcoords)),ylim = c(min(ycoords),max(ycoords)),zlim = c(min(surface.matrix),max(surface.matrix)))
text(x=11,y=1.5,"x",cex = 1.5,font = 2)
MakeLetter("(b)")

#Bottom left plot:
par(new = "TRUE",plt = c(0.1,0.4,0.15,0.5),las = 1,cex.axis = 1)
filled.contour3(xcoords,ycoords,surface.matrix,col=gray(seq(1,.1,length=11)), nlevels=11,xlab = "",ylab = "",xlim = c(min(xcoords),max(xcoords)),ylim = c(min(ycoords),max(ycoords)),zlim = c(-1,1))
text(x=11,y=1.5,"x",cex = 1.5,font = 2,col = "white")
MakeLetter("(c)")

#Bottom right plot:
par(new = "TRUE",plt = c(0.5,0.8,0.15,0.5),las = 1,cex.axis = 1)
filled.contour3(xcoords,ycoords,surface.matrix,color = terrain.colors,xlab = "",ylab = "",xlim = c(min(xcoords),max(xcoords)),ylim = c(min(ycoords),max(ycoords)),zlim = c(-1,1))
text(x=11,y=1.5,"hello",cex = 1.5,font = 2)
MakeLetter("(d)")

#Add a legend:
par(new = "TRUE",plt = c(0.85,0.9,0.25,0.85),las = 1,cex.axis = 1)
filled.legend(xcoords,ycoords,surface.matrix,color = terrain.colors,xlab = "",ylab = "",xlim = c(min(xintercepts),max(xintercepts)),ylim = c(min(slopes),max(slopes)),zlim = c(-1,1))

#Add some figure labels
par(xpd=NA,cex = 1.3)
text(x = -16.7,y = 0,"slope",srt = 90,cex = 1.3)
text(x = -8,y = -1.62,expression(paste(italic(x),"-intercept",sep = "")),cex = 1.3)

Initially, I thought it was because filledcontour should be filled.contour. However, after this change almost the same error message popped up. Or maybe this is some version problem since the codes were written in 2010. Can anyone tell me why I had such problem and how to fix it, please?

Answer 1

Pasting the code is very helpful. It looks like there have been changes to the way filled.contour works since that code was first posted. Change the line

.Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), 
       col = col))

to

.filled.contour(as.double(x), as.double(y), z, as.double(levels), 
       col = col)

Doing that I got the plot