如何在R中制作渐变色填充时间序列图

Question

渐变颜色如何填充区域在（sp）行之下和之上？

此示例已在Inkscape中绘制 - 但我需要垂直渐变 - 非水平。

  

从零到正面 ==从白色到红色的间隔。

     

从零到否定 ==从白色到红色的时间间隔。

是否有 包 可以执行此操作？

我编造了一些源数据......

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)

Answer 1

这是一种方法，它在很大程度上依赖于几个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)

Answer 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)

Answer 3

这是欺骗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() 

颜色不是你想要的颜色，但无论如何它可能太慢了。

Answer 4

另一种使用grid和gridSVG包中的函数的可能性。

我们首先根据@ kohske here描述的方法，通过线性插值生成额外的数据点。然后，基本图将由两个单独的多边形组成，一个用于负值，另一个用于正值。

在渲染图之后，grid.ls用于显示grob的列表，即图的所有构建块。在列表中，我们将（除其他外）找到两个geom_area.polygon;一个表示值<= 0的多边形，另一个表示值>= 0。

然后使用grobs函数处理多边形gridSVG的填充：使用linearGradient创建自定义颜色渐变，并使用{替换grobs的填充{1}}。

grid.gradientFill包的作者之一Simon Potter的MSc thesis第7章很好地描述了对grob渐变的操纵。

gridSVG

您可以轻松地为正多边形和负多边形创建不同的颜色渐变。例如。如果您希望负值从白色变为蓝色，请将上面的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