Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

filled.contour in R 3.0.x throws error

Tags:

plot

r

contour

I have a customized function for plotting filled contours which is heavily based on Carey McGilliard and Bridget Ferris work (http://wiki.cbr.washington.edu/qerm/sites/qerm/images/1/16/Filled.contour3.R) and http://wiki.cbr.washington.edu/qerm/index.php/R/Contour_Plots .

the filled.contour3 function runs perfectly in R 2.15.3 but throws an error in R 3.0.x

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

Could you please help me with a solution or a workarround so that I can use the filled.contour3() function in R 3.0.x . *A great deal of my work depends on this function and I am on LInux so changing R versions is not that easy on production machines. Will be happy to offer bounty.*

To reproduce the error please source first the following

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()
#}

and then run

#Example Four Panel Contour Plot with One Legend
#Author: Carey R McGilliard
#September 2010

#This code uses a modified version of filled.contour called filled.contour3 (created by Carey McGilliard, Ian Taylor, and Bridget Ferris)
#to make an example figure of four contour plots sharing a legend (to the right).
#The example demonstrates how to use various color schemes for the contour plots and legend, but the user will want to
#pick one color scheme for all four plots such that the legend matches the plots.
#Changing the x- and y-axis values will change the placement of text added to the figure using the text() function and adjustments will be necessary


#Source the following functions (change the paths as necessary)
#source("./print.letterTrevor.R")

#gplots has the function colorpanel, which is handy for making gray-scale contour plots
library(gplots)

#------------------------------------------------------
#Generate some fake data
x = rep(c(10,11,12),length = 9)
y = rep(c(1,2,3),each = 3)
z = rnorm(n=9,mean = 0,sd = 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),   # using plt instead of mfcol (compare
        # coordinates in other plots)
        las = 1,                      # orientation of axis labels
        cex.axis = 1,                 # size of axis annotation
        tck = -0.02 )                 # major tick size and direction, < 0 means outside

#Top left plot:
#
# the filled contour - coloured areas
filled.contour3(xcoords,
                                ycoords,
                                surface.matrix,
                                color=terrain.colors,
                                xlab = "",        # suppress x-axis annotation
                                ylab = "",        # suppress y-axis annotation
                                xlim = c(min(xcoords),max(xcoords)),
                                ylim = c(min(ycoords),max(ycoords)),
                                zlim = c(min(surface.matrix),max(surface.matrix))
)
# the contour part - draw iso-lines
contour(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)),
                add=TRUE,                 # add the contour plot to filled-contour,
                #thus making an overlay
                col = grey(0.4)           # color of overlay-lines
)
#
# An annotation inside first plot
#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)
print.letter(text = "(a)")

######################################################################
#
#
#Top right plot:
par(new = "TRUE",
        plt = c(0.5,0.8,0.60,0.95),  # defining window for second plot
        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)
)
#
contour(
    xcoords,
    ycoords,
    surface.matrix,
    xlab = "",
    ylab = "",
    xlim = c(min(xcoords),max(xcoords)),
    ylim = c(min(ycoords),max(ycoords)),
    zlim = c(-1,1),
    add=TRUE
)
#
#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)))
#
# Add annotation
text(x=11,
         y=1.5,
         "x",
         cex = 1.5,
         font = 2)


######################################################################
#
#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=colorpanel(11, "white", "grey10"),
                                nlevels=11,
                                xlab = "",
                                ylab = "",
                                xlim = c(min(xcoords),max(xcoords)),
                                ylim = c(min(ycoords),max(ycoords)),
                                zlim = c(-1,1))
#
contour(xcoords,
                ycoords,
                surface.matrix,
                xlab = "",
                ylab = "",
                xlim = c(min(xcoords),max(xcoords)),
                ylim = c(min(ycoords),max(ycoords)),
                zlim = c(-1,1),
                add = TRUE)
#
text(x=11,
         y=1.5,
         "x",
         cex = 1.5,
         font = 2,
         col = "white")


######################################################################
#
#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)
)
#
contour(
    xcoords,
    ycoords,
    surface.matrix,
    xlab = "",
    ylab = "",
    xlim = c(min(xcoords),max(xcoords)),
    ylim = c(min(ycoords),max(ycoords)),
    zlim = c(-1,1),
    add=TRUE
)

text(x=11,
         y=1.5,
         "hello",
         cex = 1.5,
         font = 2)


#
######################################################################
#Add a legend:
par(new = "TRUE",
        plt = c(0.85,0.9,0.25,0.85),   # define plot region for legend
        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)
like image 479
ECII Avatar asked May 29 '13 11:05

ECII


1 Answers

This happens if you use a non-standard API. You are allowed to do that, but cannot expect that it is maintained.

Change

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

The change was announced with the release notes:

The C code underlying base graphics has been migrated to the graphics package (and hence no longer uses .Internal() calls).

Have you ever heard of a "minimal reproducible example" (emphasis on "minimal")?

like image 55
Roland Avatar answered Sep 20 '22 04:09

Roland