xyplot时间序列，正值为绿色，负值为红色，单位为R

使用

lattice:：xyplot

，对于下面的（简化的）时间序列图，是否有一种简洁的方法将负值涂成红色，其他值涂成绿色

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

使用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()

---

如果要在没有点的情况下完成，那么我会坚持使用plot（而不是lattice）和clip，就像这里的一个答案：

---

dat我尝试为此编写一个自定义面板函数，该函数将在给定值上断开一行

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(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", ...) })

库（晶格）
图书馆（网格）
种子集（0）
谢谢。为了保持一致性，我必须使用xyplot。当然也有类似的简洁方法：）
plotrix:：color.scale.line
也是一个不错的选择。谢谢。我明白你说的“一条线”（在相邻的正负值之间）的意思了。我希望有一种方法可以用两种颜色来显示这条线，零上的绿色和零下的红色。这可能涉及到向图形中添加点（以断开与零坐标相交的线），可能需要使用线性插值。希望有一个自动的函数或参数可以这样做。如果直方图正常，那么：
xyplot（z，type=“h”，col=ifelse（z>0，“绿色”，“红色”））
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")

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", ...) })