R lapply : plot data by row Error "invalid value specified for graphical parameter "pin"

Question

我有一个由 {climatol} 包创建的 windrose。行代表组(以 m/s 为单位的风速)，列是地理标志(N-North，S-South，...)。

     N NNE NE ENE  E ESE SE SSE  S SSW SW WSW  W WNW NW NNW
0-3 59  48 75  90 71  15 10  11 14  20 22  22 24  15 19  33
3-6  3   6 29  42 11   3  4   3  9  50 67  28 14  13 15   5
6-9  1   3 16  17  2   0  0   0  2  16 33  17  6   5  9   2
> 9  0   1  2   3  0   0  0   0  0   1  4   3  1   1  2   0

我可以成功绘制所有行的数据:

相反，我想创建 4 个图，每行 1 个。我试过了

par(mfrow=c(2,2))

但我收到错误:

 Error in par(old.par) : 
  invalid value specified for graphical parameter "pin" 

子集和函数似乎没问题，因为如果我在函数中添加 windows() 就可以绘制单独的图。但是如何并排绘制它们？

因为我没有使用 ggplot，所以我不确定在这种情况下如何使用 grid.arrange...

---

我的虚拟数据

require(climatol)

data(windfr)

# Create general plot
rosavent(windfr, 4, 4, ang=-3*pi/16, main="Annual windrose")


# identify unique rows
ii<-rownames(windfr)

# define the plotting of 4 plots - NOT WORKING!!
par(mfrow=c(2,2)) 

# function to subset each row and create plot 
lapply(ii, function(i) {
  #windows()
  rosavent(subset(windfr, rownames(windfr) == i),
           5, # number of rings
           10, # between rings
           ang =-3*pi/16,
           main = i ) })

感谢您的建议!

Answer 1

在 rosavent() 的代码中，他们在退出时重置了 par。以下是摘录。据我所知，对此几乎无能为力。

old.par <- par(no.readonly = TRUE)
on.exit(par(old.par))

.. 除了删除那部分并制作我们自己的 rosavent2() 函数😈

rosavent2 <- function (frec, fnum = 4, fint = 5, flab = 2, ang = 3 * pi/16, 
    col = rainbow(10, 0.5, 0.92, start = 0.33, end = 0.2), margen = c(0, 
        0, 4, 0), key = TRUE, uni = "m/s", ...) 
{
    ## old.par <- par(no.readonly = TRUE)
    ## on.exit(par(old.par))
    if (is.matrix(frec)) 
        frec <- as.data.frame(frec)
    if (is.vector(frec)) {
        ndir <- length(frec)
        nr <- 1
    }
    else {
        ndir <- length(frec[1, ])
        nr <- nrow(frec)
    }
    fmax <- fnum * fint
    tot <- sum(frec)
    fr <- 100 * frec/tot
    key <- (nr > 1) && key
    if (key) 
        mlf <- 3
    else mlf <- 1
    par(mar = margen, new = FALSE)
    fx <- cos(pi/2 - (2 * pi/ndir * 0:(ndir - 1)))
    fy <- sin(pi/2 - (2 * pi/ndir * 0:(ndir - 1)))
    plot(fx, fy, xlim = c(-fmax - mlf * fint, fmax + fint), ylim = c(-fmax - 
        fint, fmax + fint), xaxt = "n", yaxt = "n", xlab = "", 
        ylab = "", bty = "n", asp = 1, type = "n", ...)
    if (nr == 1) {
        cx <- fx * fr
        cy <- fy * fr
    }
    else {
        f <- apply(fr, 2, sum)
        cx <- fx * f
        cy <- fy * f
        for (i in nr:2) {
            f <- f - fr[i, ]
            cx <- c(cx, NA, fx * f)
            cy <- c(cy, NA, fy * f)
        }
    }
    polygon(cx, cy, col = col[nr:1])
    symbols(c(0 * 1:fnum), c(0 * 1:fnum), circles = c(fint * 
        1:fnum), inches = FALSE, add = TRUE)
    segments(0 * 1:ndir, 0 * 1:ndir, fmax * fx, fmax * fy)
    fmaxi <- fmax + fint/4
    text(0, fmaxi, "N")
    text(0, -fmaxi, "S")
    text(fmaxi, 0, "E")
    text(-fmaxi, 0, "W")
    if (flab == 2) 
        for (i in 1:fnum) text(i * fint * cos(ang), i * fint * 
            sin(ang), paste(i * fint, "%"))
    else if (flab == 1) 
        text(fmax * cos(ang), fmax * sin(ang), paste(fmax, "%"))
    if (key) {
        legend(-fmaxi - 2.3 * fint, fmaxi + 2, fill = col, legend = attr(frec, 
            "row.names"))
        text(-fmaxi - 1.4 * fint, fmaxi + 0.9 * fint, uni)
    }
    invisible()
}

让我们试一试。

op <- par(mfrow = c(2, 2))

for (i in rownames(windfr)) {
  rosavent2(
    frec = windfr[which(rownames(windfr) == i), ],
    fnum = 5,
    fint = 10,
    ang = -3*pi/16,
    main = i
  )
}

par(op)