Skip to content
Prev 40943 / 63424 Next

one way to solve bad looking density plots in postscript

Sorry, I must have made a mistake before.
In my R, the attached replacement for image.default DOES put the axes last, and does look better. 

I also tested my code for the change in the eps header on some linux machines (I'm using a mac), and there the grid effects were less pronounced, and my code did not help...

anyway, here is the plot.default function that does seem to put the box after the image is drawn.


Michael


The only change is adding box(...) at the end, and doing the first call to plot with bty="n".
--
image.default = function (x = seq(0, 1, length.out = nrow(z)), y = seq(0, 1, 
    length.out = ncol(z)), z, zlim = range(z[is.finite(z)]), 
    xlim = range(x), ylim = range(y), col = heat.colors(12), 
    add = FALSE, xaxs = "i", yaxs = "i", xlab, ylab, breaks, 
    oldstyle = FALSE, useRaster = FALSE, ...) 
{
    if (missing(z)) {
        if (!missing(x)) {
            if (is.list(x)) {
                z <- x$z
                y <- x$y
                x <- x$x
            }
            else {
                if (is.null(dim(x))) 
                  stop("argument must be matrix-like")
                z <- x
                x <- seq.int(0, 1, length.out = nrow(z))
            }
            if (missing(xlab)) 
                xlab <- ""
            if (missing(ylab)) 
                ylab <- ""
        }
        else stop("no 'z' matrix specified")
    }
    else if (is.list(x)) {
        xn <- deparse(substitute(x))
        if (missing(xlab)) 
            xlab <- paste(xn, "x", sep = "$")
        if (missing(ylab)) 
            ylab <- paste(xn, "y", sep = "$")
        y <- x$y
        x <- x$x
    }
    else {
        if (missing(xlab)) 
            xlab <- if (missing(x)) 
                ""
            else deparse(substitute(x))
        if (missing(ylab)) 
            ylab <- if (missing(y)) 
                ""
            else deparse(substitute(y))
    }
    if (any(!is.finite(x)) || any(!is.finite(y))) 
        stop("'x' and 'y' values must be finite and non-missing")
    if (any(diff(x) <= 0) || any(diff(y) <= 0)) 
        stop("increasing 'x' and 'y' values expected")
    if (!is.matrix(z)) 
        stop("'z' must be a matrix")
    if (length(x) > 1 && length(x) == nrow(z)) {
        dx <- 0.5 * diff(x)
        x <- c(x[1] - dx[1], x[-length(x)] + dx, x[length(x)] + 
            dx[length(x) - 1])
    }
    if (length(y) > 1 && length(y) == ncol(z)) {
        dy <- 0.5 * diff(y)
        y <- c(y[1] - dy[1], y[-length(y)] + dy, y[length(y)] + 
            dy[length(y) - 1])
    }
    if (missing(breaks)) {
        nc <- length(col)
        if (!missing(zlim) && (any(!is.finite(zlim)) || diff(zlim) < 
            0)) 
            stop("invalid z limits")
        if (diff(zlim) == 0) 
            zlim <- if (zlim[1] == 0) 
                c(-1, 1)
            else zlim[1] + c(-0.4, 0.4) * abs(zlim[1])
        z <- (z - zlim[1])/diff(zlim)
        zi <- if (oldstyle) 
            floor((nc - 1) * z + 0.5)
        else floor((nc - 1e-05) * z + 1e-07)
        zi[zi < 0 | zi >= nc] <- NA
    }
    else {
        if (length(breaks) != length(col) + 1) 
            stop("must have one more break than colour")
        if (any(!is.finite(breaks))) 
            stop("breaks must all be finite")
        zi <- .C("bincode", as.double(z), length(z), as.double(breaks), 
            length(breaks), code = integer(length(z)), (TRUE), 
            (TRUE), nok = TRUE, NAOK = TRUE, DUP = FALSE, PACKAGE = "base")$code - 
            1
    }
    if (!add) 
        plot(NA, NA, xlim = xlim, ylim = ylim, type = "n", xaxs = xaxs, 
            yaxs = yaxs, xlab = xlab, ylab = ylab,bty="n", ...)
    if (length(x) <= 1) 
        x <- par("usr")[1:2]
    if (length(y) <= 1) 
        y <- par("usr")[3:4]
    if (length(x) != nrow(z) + 1 || length(y) != ncol(z) + 1) 
        stop("dimensions of z are not length(x)(-1) times length(y)(-1)")
    if (useRaster) {
        dx <- diff(x)
        dy <- diff(y)
        if ((length(dx) && !isTRUE(all.equal(dx, rep(dx[1], length(dx))))) || 
            (length(dy) && !isTRUE(all.equal(dy, rep(dy[1], length(dy)))))) 
            stop("useRaster=TRUE can only be used with a regular grid")
        if (!is.character(col)) {
            p <- palette()
            pl <- length(p)
            col <- as.integer(col)
            col[col < 1] <- NA
            col <- p[((col - 1)%%pl) + 1]
        }
        zc <- col[zi + 1]
        dim(zc) <- dim(z)
        zc <- t(zc)[ncol(zc):1, ]
        rasterImage(as.raster(zc), min(x), min(y), max(x), max(y), 
            interpolate = FALSE)
    }
    else .Internal(image(as.double(x), as.double(y), as.integer(zi), 
        col))
    box(...)
}

--
On 3 Aug 2011, at 11:14PM, baptiste auguie wrote: