r - 填充区域以匹配网格中各种 'type' 参数的行

Question

我知道我可以使用latticeExtra中的panel.xyarea来用任何颜色填充图中的区域。如果没有在xyplot中定义type参数，这样的填充将遵循默认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,...)}) 

这会绘制 panel.xyarea 以及来自 panel.xyplot 中默认 type="p" 的点。现在，当我想更改绘图线的 type 时，例如使其成为步进函数 type="S":

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

正如您在上面的示例中看到的，panel.xyarea 不会填充新步骤函数下方的区域，而是绘制两个重叠的区域。如果我将 type="S" 移动到 panel.xyarea，它不会改变任何东西 - 事实上它没有注册 type 参数它根本就不存在，并且绘图因为它不会在那里。

有没有一种方法可以绕过这个问题，让 panel.xyarea 填充我的绘图，无论我定义什么类型 - 无论是步骤函数(type="S")，黄土 (type="smooth") 或回归 (type="r")？或者也许有比 panel.xyarea 更好的东西可以在这种情况下使用？

Answer 1

对于type的每个值，您需要构建一个自定义面板函数。幸运的是，如果您在现有的lattice代码上紧密建模函数(首先查看panel.xyplot)，那么这应该不会太难。例如，下面的两个自定义面板函数包含很多行代码，但我只需要编写几行(用注释标记)。

一旦定义了面板功能(从图后面的代码块中复制它们)，请像这样使用它们:

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)

对于 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")

对于 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
}