R: как установить размер контурного графика с заданным пользователем соотношением сторон?

Я пытаюсь построить (заполненную) контурную карту с соотношением сторон = 1, но мне не удается получить правильную форму окна графика / у меня остаются области в окне графика, которые являются белыми, потому что окно графика (или поле) всегда остается квадратом. Пожалуйста, смотрите пример ниже

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

приводит к следующему графику:filled.contour

как избавиться от белых областей в окне графика/окне, сохранив при этом соотношение сторон? Я предполагаю, что мне нужно где-то установить размер окна графика, но не могу понять, как это сделать; кажется, что настройки графических параметров (используя par) перезаписываются fill.contour (или установкой asp = 1)


person Lukas    schedule 15.08.2013    source источник
comment
С image вместо filled.contour можно снять коробку с axes=FALSE и добавить самому, не с box(), а с rect( min(x), min(y), max(x), max(y) ). Поскольку filled.contour использует layout и par, восстановить правильные координаты становится сложнее.   -  person Vincent Zoonekynd    schedule 15.08.2013
comment
вы можете установить для frame.plot значение false и сместить оси. проверьте это r.789695.n4.nabble.com /Contour-Plot-Aspect-Ratio-td869340.html   -  person user2510479    schedule 15.08.2013
comment
Спасибо обоим. Но нет ли более элегантного способа? Использование решения 1 означает потерю вашей легенды, а rect() не заменяет оси (галочки, метки и т. д.). С решением 2 вы теряете текст легенды, и легенда по-прежнему имеет исходный размер (высоту) и выше, чем фактический график.   -  person Lukas    schedule 15.08.2013


Ответы (2)


У меня возникла такая же проблема для моего проекта. Я разработал решение, настроив функцию fill.contour() таким образом, чтобы рамка рисовалась только вокруг области, где наблюдаются значения. Также легенда подогнана под настраиваемый ящик. Применяя настроенную функцию fill.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()

        }
person Marcus Groß    schedule 14.06.2019

Попробуй это

  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)) })
person user2510479    schedule 16.08.2013