[英]xyplot time series with positive values in green, negative in red, in R
Lattice is based on grid
so you can use grid's clipping functionality Lattice基于
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", ...) })
When using type="l" you only have one "line" and it's all one color, so you might instead choose to color points: 当使用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()
I found a solution by, Sundar Dorai-Rag, a fellow now at Google, to a similar request (to color the enclosed areas above and below 0, for which his approach to getting the crossing values for the X's was to invert the results of approx
) as seen here: http://r.789695.n4.nabble.com/shading-under-the-lines-in-a-lattice-xyplot-td793875.html . 我找到了一个解决方案,由现在谷歌的家伙Sundar Dorai-Rag提出了类似的要求(为0和0以上的封闭区域着色,他为此获得X的交叉值的方法是反转结果
approx
)如下所示: http : //r.789695.n4.nabble.com/shading-under-the-lines-in-a-lattice-xyplot-td793875.html 。 Instead of coloring the enclosed areas, I gave the borders of the polygons the desired colors and left the interior "transparent": 我没有给封闭区域着色,而是给多边形的边框赋予了所需的颜色,并使内部“透明”:
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()
I tried writing a custom panel function for this that will break a line on a given value 我尝试为此编写一个自定义面板函数,它将在给定值上打破一条线
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))
}
You can run with 你可以跑
library(zoo)
library(lattice)
set.seed(0)
zz<-zoo(cumsum(rnorm(100)))
xyplot(zz, grid=T, panel.groups=panel.breakline)
And you can change the break point or the colors as well 您也可以更改断点或颜色
xyplot(zz, grid=T, panel.groups=panel.breakline,
breakat=2, upper.col="blue", lower.col="orange")
If one was to do it without points, then I'd stick to plot (instead of lattice) and use clip , like in one of the answers here : Plot a line chart with conditional colors depending on values 如果一个人没有点,那么我会坚持绘图(而不是格子)并使用剪辑,就像在这里的一个答案中一样: 根据值绘制带有条件颜色的折线图
dat<- zoo(cumsum(rnorm(100)))
plot(dat, col="red")
clip(0,length(dat),0,max(dat) )
lines(dat, col="green")
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.