如何在R中制作渐变颜色填充时间序列图
Posted
技术标签:
【中文标题】如何在R中制作渐变颜色填充时间序列图【英文标题】:How to make gradient color filled timeseries plot in R 【发布时间】:2015-01-30 18:22:52 【问题描述】:如何用渐变色填充区域上下(sp)线?
这个例子是在 Inkscape 中绘制的 - 但我需要 垂直渐变 - 不是水平的。
从零到正的间隔==从白色到红色。
从零到负的间隔==从white到red。
是否有任何 包 可以做到这一点?
我捏造了一些源数据....
set.seed(1)
x<-seq(from = -10, to = 10, by = 0.25)
data <- data.frame(value = sample(x, 25, replace = TRUE), time = 1:25)
plot(data$time, data$value, type = "n")
my.spline <- smooth.spline(data$time, data$value, df = 15)
lines(my.spline$x, my.spline$y, lwd = 2.5, col = "blue")
abline(h = 0)
【问题讨论】:
【参考方案1】:使用grid
和gridSVG
包中的函数的另一种可能性。
我们首先根据@kohskehere 描述的方法,通过线性插值生成额外的数据点。然后,基本图将由两个单独的多边形组成,一个用于负值,一个用于正值。
情节渲染后,grid.ls
用于显示grob
s 的列表,即情节的所有构建块。在列表中,我们将(除其他外)找到两个geom_area.polygon
s;一个代表值<= 0
的多边形,一个代表值>= 0
的多边形。
然后使用gridSVG
函数处理多边形grobs
的填充:使用linearGradient
创建自定义颜色渐变,使用grid.gradientFill
替换grobs
的填充。
grob
梯度的操作在 gridSVG
包的作者之一 Simon Potter 的 MSc thesis 的第 7 章中有很好的描述。
library(grid)
library(gridSVG)
library(ggplot2)
# create a data frame of spline values
d <- data.frame(x = my.spline$x, y = my.spline$y)
# create interpolated points
d <- d[order(d$x),]
new_d <- do.call("rbind",
sapply(1:(nrow(d) -1), function(i)
f <- lm(x ~ y, d[i:(i+1), ])
if (f$qr$rank < 2) return(NULL)
r <- predict(f, newdata = data.frame(y = 0))
if(d[i, ]$x < r & r < d[i+1, ]$x)
return(data.frame(x = r, y = 0))
else return(NULL)
)
)
# combine original and interpolated data
d2 <- rbind(d, new_d)
d2
# set up basic plot
ggplot(data = d2, aes(x = x, y = y)) +
geom_area(data = subset(d2, y <= 0)) +
geom_area(data = subset(d2, y >= 0)) +
geom_line() +
geom_abline(intercept = 0, slope = 0) +
theme_bw()
# list the name of grobs and look for relevant polygons
# note that the exact numbers of the grobs may differ
grid.ls()
# GRID.gTableParent.878
# ...
# panel.3-4-3-4
# ...
# areas.gTree.834
# geom_area.polygon.832 <~~ polygon for negative values
# areas.gTree.838
# geom_area.polygon.836 <~~ polygon for positive values
# create a linear gradient for negative values, from white to red
col_neg <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(1, "npc"), y1 = unit(0, "npc"))
# replace fill of 'negative grob' with a gradient fill
grid.gradientFill("geom_area.polygon.832", col_neg, group = FALSE)
# create a linear gradient for positive values, from white to red
col_pos <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
# replace fill of 'positive grob' with a gradient fill
grid.gradientFill("geom_area.polygon.836", col_pos, group = FALSE)
# generate SVG output
grid.export("myplot.svg")
您可以轻松地为正多边形和负多边形创建不同的颜色渐变。例如。如果您希望负值从白色变为蓝色,请将上面的 col_pos
替换为:
col_pos <- linearGradient(col = c("white", "blue"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
【讨论】:
【参考方案2】:这是base
R 中的一种方法,我们用渐变颜色的矩形填充整个绘图区域,然后用白色填充感兴趣区域的反面。
shade <- function(x, y, col, n=500, xlab='x', ylab='y', ...)
# x, y: the x and y coordinates
# col: a vector of colours (hex, numeric, character), or a colorRampPalette
# n: the vertical resolution of the gradient
# ...: further args to plot()
plot(x, y, type='n', las=1, xlab=xlab, ylab=ylab, ...)
e <- par('usr')
height <- diff(e[3:4])/(n-1)
y_up <- seq(0, e[4], height)
y_down <- seq(0, e[3], -height)
ncolor <- max(length(y_up), length(y_down))
pal <- if(!is.function(col)) colorRampPalette(col)(ncolor) else col(ncolor)
# plot rectangles to simulate colour gradient
sapply(seq_len(n),
function(i)
rect(min(x), y_up[i], max(x), y_up[i] + height, col=pal[i], border=NA)
rect(min(x), y_down[i], max(x), y_down[i] - height, col=pal[i], border=NA)
)
# plot white polygons representing the inverse of the area of interest
polygon(c(min(x), x, max(x), rev(x)),
c(e[4], ifelse(y > 0, y, 0),
rep(e[4], length(y) + 1)), col='white', border=NA)
polygon(c(min(x), x, max(x), rev(x)),
c(e[3], ifelse(y < 0, y, 0),
rep(e[3], length(y) + 1)), col='white', border=NA)
lines(x, y)
abline(h=0)
box()
这里有一些例子:
xy <- curve(sin, -10, 10, n = 1000)
shade(xy$x, xy$y, c('white', 'blue'), 1000)
或者使用颜色渐变调色板指定的颜色:
shade(xy$x, xy$y, heat.colors, 1000)
并应用于您的数据,尽管我们首先将点内插到更精细的分辨率(如果我们不这样做,渐变不会紧跟它与零交叉的线)。
xy <- approx(my.spline$x, my.spline$y, n=1000)
shade(xy$x, xy$y, c('white', 'red'), 1000)
【讨论】:
【参考方案3】:这是一种方法,它严重依赖于多个 R 空间包。
基本思路是:
绘制一个空图,即在其上放置后续元素的画布。 (首先这样做还可以让您检索绘图的用户坐标,这是后续步骤中需要的。)
使用对rect()
的矢量化调用来设置背景颜色。获取颜色渐变的繁琐细节实际上是最棘手的部分。
使用 rgeos 中的拓扑函数首先找到图中的闭合矩形,然后找到它们的补集。在背景清洗上用白色填充绘制补色会覆盖多边形内所有除了的颜色,这正是你想要的。
最后,使用plot(..., add=TRUE)
、lines()
、abline()
等设置您希望绘图显示的任何其他细节。
library(sp)
library(rgeos)
library(raster)
library(grid)
## Extract some coordinates
x <- my.spline$x
y <- my.spline$y
hh <- 0
xy <- cbind(x,y)
## Plot an empty plot to make its coordinates available
## for next two sections
plot(data$time, data$value, type = "n", axes=FALSE, xlab="", ylab="")
## Prepare data to be used later by rect to draw the colored background
COL <- colorRampPalette(c("red", "white", "red"))(200)
xx <- par("usr")[1:2]
yy <- c(seq(min(y), hh, length.out=100), seq(hh, max(y), length.out=101))
## Prepare a mask to cover colored background (except within polygons)
## (a) Make SpatialPolygons object from plot's boundaries
EE <- as(extent(par("usr")), "SpatialPolygons")
## (b) Make SpatialPolygons object containing all closed polygons
SL1 <- SpatialLines(list(Lines(Line(xy), "A")))
SL2 <- SpatialLines(list(Lines(Line(cbind(c(0,25),c(0,0))), "B")))
polys <- gPolygonize(gNode(rbind(SL1,SL2)))
## (c) Find their difference
mask <- EE - polys
## Put everything together in a plot
plot(data$time, data$value, type = "n")
rect(xx[1], yy[-201], xx[2], yy[-1], col=COL, border=NA)
plot(mask, col="white", add=TRUE)
abline(h = hh)
plot(polys, border="red", lwd=1.5, add=TRUE)
lines(my.spline$x, my.spline$y, col = "red", lwd = 1.5)
【讨论】:
【参考方案4】:这是欺骗ggplot
做你想做的事的可怕方法。本质上,我在曲线下制作了一个巨大的点网格。由于无法在单个多边形内设置渐变,因此您必须制作单独的多边形,因此网格。像素设置太低会很慢。
gen.bar <- function(x, ymax, ypixel)
if (ymax < 0) ypixel <- -abs(ypixel)
else ypixel <- abs(ypixel)
expand.grid(x=x, y=seq(0,ymax, by = ypixel))
# data must be in x order.
find.height <- function (x, data.x, data.y)
base <- findInterval(x, data.x)
run <- data.x[base+1] - data.x[base]
rise <- data.y[base+1] - data.y[base]
data.y[base] + ((rise/run) * (x - data.x[base]))
make.grid.under.curve <- function(data.x, data.y, xpixel, ypixel)
desired.points <- sort(unique(c(seq(min(data.x), max(data.x), xpixel), data.x)))
desired.points <- desired.points[-length(desired.points)]
heights <- find.height(desired.points, data.x, data.y)
do.call(rbind,
mapply(gen.bar, desired.points, heights,
MoreArgs = list(ypixel), SIMPLIFY=FALSE))
xpixel = 0.01
ypixel = 0.01
library(scales)
grid <- make.grid.under.curve(data$time, data$value, xpixel, ypixel)
ggplot(grid, aes(xmin = x, ymin = y, xmax = x+xpixel, ymax = y+ypixel,
fill=abs(y))) + geom_rect()
颜色不是你想要的,但它可能太慢了,不适合认真使用。
【讨论】:
以上是关于如何在R中制作渐变颜色填充时间序列图的主要内容,如果未能解决你的问题,请参考以下文章