R lapply: построение данных по строкам Ошибка "указано неверное значение для графического параметра" pin " - PullRequest
Новая
       21

R lapply: построение данных по строкам Ошибка "указано неверное значение для графического параметра" pin "

0 голосов
/ 15 мая 2018

У меня есть роза ветров , созданная пакетом {climatol}. Строка представляет группы (скорость ветра в м / с), столбцы - географические указания (N-Север, S-Юг, ...). 

     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

Я могу успешно построить данные со всеми строками:

enter image description here

Вместо этого я хотел бы создать 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 ) })

Спасибо за ваши предложения!

1 Ответ

0 голосов
/ 15 мая 2018

В коде для rosavent() они сбрасывают номинал при выходе.Ниже приведен отрывок.Насколько мне известно, с этим мало что можно сделать. 

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)

rosavent2

...