1

我正在尝试绘制纵横比 = 1 的（填充）等高线图，但我无法获得绘图窗口的正确形状/我在绘图窗口中留下了白色的区域，因为绘图窗口（或框）始终保持正方形。请看下面的例子

x <- 10*1:nrow(volcano)
y <- 10*1:ncol(volcano)
filled.contour (x, y, volcano, asp = 1)

结果如下所示：填充轮廓

如何在保持纵横比的同时去除绘图框/窗口中的白色区域？我假设我需要在某处设置绘图窗口的大小，但不知道如何；似乎图形参数设置（使用par）被fill.contour（或设置asp = 1）覆盖

4

2 回答 2

1

我的一个项目遇到了同样的问题。我通过调整 fill.contour() 函数制定了一个解决方案，使框仅在观察值的区域周围绘制。图例也适合调整后的盒子。通过应用自定义函数filled.contourNew()，我得到以下图：

调整后的填充等值线图

filled.contourNew <- 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
          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)
          pin1 <- par("pin")
          a = (pin1[1] + par("mai")[2] + par("mai")[4])
          b = (pin1[2] + par("mai")[1] + par("mai")[3])

          ratio <- abs(diff(ylim)) / abs(diff(xlim))

          ratioXY <- (a / b) * asp

          if (abs(diff(xlim)) / abs(diff(ylim)) >= ratioXY){

            par(plt = c(0.15, 0.5, 0.525 - ratio * ratioXY / 2 * 0.75,
                        0.525 + ratio * ratioXY / 2 * 0.75))
          }
          if (abs(diff(xlim)) / abs(diff(ylim)) < ratioXY){
            par(plt = c(0.15, 0.5, 0.15, 0.9))
          }
          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)
          #browser()
          a = (pin1[1] + par("mai")[2] + par("mai")[4])
          b = (pin1[2] + par("mai")[1] + par("mai")[3])

          ratio <- abs(diff(ylim)) / abs(diff(xlim))

          ratioXY <- (a / b) * asp
          if (abs(diff(xlim)) / abs(diff(ylim)) >= ratioXY){

            par(plt = c(0.15, 0.9, 0.525 - ratio * ratioXY / 2 * 0.75,
                        0.525 + ratio * ratioXY / 2 * 0.75))
          }
          if (abs(diff(xlim)) / abs(diff(ylim)) < ratioXY){
            par(plt = c(0.525 - 1 / ratioXY / 2 * 0.75 / ratio,
                        0.525 + 1 / ratioXY / 2 * 0.75 / ratio, 0.15, 0.9))
          }
          plot.new()
          plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
          .filled.contour(x, y, z, levels, 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()

        }
于 2019-06-14T13:24:02.320 回答
0

尝试这个

  x <- 10*1:nrow(volcano)
  y <- 10*1:ncol(volcano)
  filled.contour(x, y, volcano,asp=1, frame.plot=F,
  plot.axes = { axis(1, pretty(x,min=0), line=-4)
                axis(2, seq(0, 600, by = 100)) })
于 2013-08-16T04:52:58.890 回答