在R中，使用xyplot绘制时间序列图，正值显示为绿色，负值显示为红色。

Question

使用 lattice::xyplot 简化的时间序列图中，有没有一种简便的方法，在红色中显示负值，在绿色中显示其他值？

set.seed(0)
xyplot(zoo(cumsum(rnorm(100))), grid=T)

- Oleg Melnikov

---

如果直方图正常，则执行以下操作：xyplot(z, type = "h", col = ifelse(z > 0, "green", "red")) - G. Grothendieck

Answer 1

Lattice基于grid，因此您可以使用grid的裁剪功能。

library(lattice)
library(grid)

set.seed(0)
x <- zoo(cumsum(rnorm(100)))

xyplot(x, grid=TRUE, panel = function(x, y, ...){
       panel.xyplot(x, y, col="red", ...) 
       grid.clip(y=unit(0,"native"),just=c("bottom"))
       panel.xyplot(x, y, col="green", ...) })

- A. Webb

Answer 2

当使用 type="l" 时，你只有一条“线”，它全部是一个颜色，因此你可能会选择着色点：

set.seed(0); require(zoo); require(lattice)
vals <- zoo(cumsum(rnorm(100)))
png()
xyplot(vals, type=c("l","p"), col=c("red", "green")[1+( vals>0)], grid=T)
dev.off()

我找到了一位名为Sundar Dorai-Rag的谷歌员工提出的解决方案，用于类似请求（对于将0以上和以下的封闭区域着色，他的方法是获取X的交叉值并反转approx的结果）。可以在这里看到：http://r.789695.n4.nabble.com/shading-under-the-lines-in-a-lattice-xyplot-td793875.html。我没有给封闭区域上色，而是给多边形的边框涂上所需的颜色，并将内部保留“透明”。

lpolygon <- function (x, y = NULL, border = NULL, col = NULL, ...) { 
   require(grid, TRUE) 
   xy <- xy.coords(x, y) 
   x <- xy$x 
   y <- xy$y 
   gp <- list(...) 
   if (!is.null(border)) gp$col <- border 
   if (!is.null(col)) gp$fill <- col 
   gp <- do.call("gpar", gp) 
   grid.polygon(x, y, gp = gp, default.units = "native") 
} 

find.zero <- function(x, y) { 
   n <- length(y) 
   yy <- c(0, y) 
   wy <- which(yy[-1] * yy[-n - 1] < 0) 
   if(!length(wy)) return(NULL) 
   xout <- sapply(wy, function(i) { 
     n <- length(x) 
     ii <- c(i - 1, i) 
     approx(y[ii], x[ii], 0)$y 
   }) 
   xout 
} 

trellis.par.set(theme = col.whitebg()) 
png();
xyplot(vals, panel = function(x,y, ...) { 
        x.zero <- find.zero(x, y) 
        y.zero <- y > 0 
        yy <- c(y[y.zero], rep(0, length(x.zero))) 
        xx <- c(x[y.zero], x.zero) 
        ord <- order(xx) 
        xx <- xx[ord] 
        xx <- c(xx[1], xx, xx[length(xx)]) 
        yy <- c(0, yy[ord], 0) 
        lpolygon(xx, yy, col="transparent", border = "green") 
        yy <- c(y[!y.zero], rep(0, length(x.zero))) 
        xx <- c(x[!y.zero], x.zero) 
        ord <- order(xx) 
        xx <- xx[ord] 
        xx <- c(xx[1], xx, xx[length(xx)]) 
        yy <- c(0, yy[ord], 0) 
        lpolygon(xx, yy, col = "transparent", border = "red") 
        panel.abline(h = 0) ;panel.grid(v=-1, h=-1 )
     }); dev.off()

- IRTFM

---

谢谢。我明白你所说的“一条线”（在相邻正负值之间）。我希望有一种方法可以用两种颜色显示这条线，绿色表示大于零，红色表示小于零。这可能涉及向图形添加点（以打破穿过零坐标的线），可能需要进行线性插值。希望有自动化函数或参数可以实现这一点。 - Oleg Melnikov

Answer 3

我尝试编写一个自定义面板函数来在给定值处换行。

panel.breakline <- function(x,y,breakat=0,col.line,upper.col="red",lower.col="green",...){
    f <- approxfun(x,y)
    ff <- function(x) f(x)-breakat
    psign <- sign(y-breakat)
    breaks <- which(diff(psign) != 0)
    interp <- sapply(breaks, function(i) uniroot(ff,c(x[i], x[i+1]))$root)
    starts <- c(1,breaks+1)
    ends <- c(breaks, length(x))

    Map(function(start,end,left,right) {
        x <- x[start:end]
        y <- y[start:end]
        col <- ifelse(y[1]>breakat,upper.col,lower.col)
        panel.xyplot(c(left, x, right) ,c(breakat,y,breakat), col.line=col,...)
    }, starts, ends, c(NA,interp), c(interp,NA))
}

你可以使用以下方式运行：

library(zoo)
library(lattice)
set.seed(0)
zz<-zoo(cumsum(rnorm(100)))

xyplot(zz, grid=T, panel.groups=panel.breakline)

你还可以更改断点或颜色

xyplot(zz, grid=T, panel.groups=panel.breakline, 
    breakat=2, upper.col="blue", lower.col="orange")

- MrFlick

Answer 4

如果不使用点，我建议使用plot（而不是lattice），并使用clip，就像这里的一个答案中所示：

绘制根据值条件着色的折线图

dat<- zoo(cumsum(rnorm(100)))

plot(dat, col="red")

clip(0,length(dat),0,max(dat) )
lines(dat, col="green")

- R.S.

---

谢谢。我必须使用xyplot以保持一致性。肯定有类似的简洁方法 :) - Oleg Melnikov

plotrix::color.scale.line 也是一个不错的选择。 - IRTFM