Wypełnij obszar, aby dopasować linie do różnych argumentów "typu" w kratownicy

Question

Wiem, że mogę użyć panel.xyarea z kratownicy, aby wypełnić obszar działki dowolnym kolorem. Bez definiowania type argumentu w xyplot, takie nadzienie będzie śledzić trasę domyślnie type="p":

library(lattice) 
library(latticeExtra) 
data <- data.frame(time=1:24,value=rnorm(24)) 
xyplot(value~time, data, 
     panel=function(x,y,...){ 
      panel.xyarea(x,y,...) 
      panel.xyplot(x,y,...)}) 

Ten działek zarówno panel.xyarea i punkty pochodzących z domyślnie type="p" w panel.xyplot. Teraz problem pojawia się, gdy chcę zmienić type o spiskowanie linii, na przykład co krok funkcję type="S":

xyplot(value~time, data, type="S", 
     panel=function(x,y,...){ 
      panel.xyarea(x,y,...) 
      panel.xyplot(x,y,...)} 

Jak widać na powyższym przykładzie, panel.xyarea nie wypełnia obszar pod nową funkcją kroku, ale zamiast tego kreśli oba obszary zachodzące na siebie. Nie zmienia niczego, jeśli przeniesię type="S" do panel.xyarea - w rzeczywistości nie rejestruje on w ogóle argumentu i wątki, ponieważ nie byłoby tam.

Czy istnieje sposób mogę to ominąć i mieć panel.xyarea wypełnić swoje działki, niezależnie od typu zdefiniować - bądź to krok funkcję (type="S"), less (type="smooth") lub regresji (type="r")? A może w takim kontekście jest coś lepszego niż panel.xyarea?

Answer 1

Dla każdej wartości type należy utworzyć niestandardową funkcję panelu. Na szczęście, jeśli dokładnie zamodelujesz funkcje istniejącego kodu kraty (zaczynając od spojrzenia na panel.xyplot), nie powinno to być zbyt trudne. Na przykład dwie niestandardowe funkcje panelu obejmują wiele linii kodu, ale tylko kilka linii (oznaczonych komentarzami), które musiałem napisać.

Po zdefiniowaniu funkcji panelu (kopiując je z bloków kodu po rysunku), należy je tak:

library(lattice) 
library(latticeExtra) 
library(gridExtra) 
set.seed(100) 
data <- data.frame(time=1:24,value=rnorm(24)) 

## Filled version of xyplot(..., type="S") 
a <- xyplot(value~time, data, panel=panel.filled_S) 
## Filled version of xyplot(..., type="smooth") 
b <- xyplot(value~time, data, panel=panel.filled_smooth) 
grid.arrange(a, b, ncol = 2) 

Do wypełnionego wersji type="S":

## Modeled on code in panel.xyplot, which is called when type=S" 
panel.filled_S <- 
function(x,y, ...) { 
    horizontal <- FALSE     ## Edited (may not want to hardcode) 
    ord <- if (horizontal) 
     sort.list(y) 
    else sort.list(x) 
    n <- length(x) 
    xx <- numeric(2 * n - 1) 
    yy <- numeric(2 * n - 1) 
    xx[2 * 1:n - 1] <- x[ord] 
    yy[2 * 1:n - 1] <- y[ord] 
    xx[2 * 1:(n - 1)] <- x[ord][-n] 
    yy[2 * 1:(n - 1)] <- y[ord][-1] 
    panel.xyarea(x = xx, y = yy, ...) ## Edited 
    panel.lines(x = xx, y = yy, ...)  ## Edited 
} 
xyplot(value~time, data, panel=panel.filled_S, type="o") 

do wypełnionego wersji type="smooth":

## Modeled on code in panel.loess, called by panel.xyplot when type="smooth" 
panel.filled_smooth <- 
function (x, y, span = 2/3, degree = 1, family = c("symmetric", 
    "gaussian"), evaluation = 50, lwd = plot.line$lwd, lty = plot.line$lty, 
    col, col.line = plot.line$col, type, horizontal = FALSE, 
    ..., identifier = "loess") 
{ 
    x <- as.numeric(x) 
    y <- as.numeric(y) 
    ok <- is.finite(x) & is.finite(y) 
    if (sum(ok) < 1) 
     return() 
    if (!missing(col)) { 
     if (missing(col.line)) 
      col.line <- col 
    } 
    plot.line <- trellis.par.get("plot.line") 
    if (horizontal) { 
     smooth <- loess.smooth(y[ok], x[ok], span = span, family = family, 
      degree = degree, evaluation = evaluation) 
     panel.lines(x = smooth$y, y = smooth$x, col = col.line, 
      lty = lty, lwd = lwd, ..., identifier = identifier) 
     panel.xyarea(smooth$y, smooth$x, ...) ## Edited 
    } 
    else { 
     smooth <- loess.smooth(x[ok], y[ok], span = span, family = family, 
      degree = degree, evaluation = evaluation) 
     panel.lines(x = smooth$x, y = smooth$y, col = col.line, 
      lty = lty, lwd = lwd, ..., identifier = identifier) 
     panel.xyarea(smooth$x, smooth$y, ...) ## Edited 
    } 
    smooth 
}