Как сделать график временных рядов с градиентным цветом в R

вот один подход, который в значительной степени зависит от нескольких R пространственных пакетов.

основная идея состоит в том, чтобы:

• построить пустой участок, холст, на который будут уложены последующие элементы. (Выполнение этого первого также позволяет получить пользовательские координаты участка, необходимые в последующих шагах.)

• используйте векторизованный вызов rect(), чтобы сложить фон мыть цвета. Получение fiddly деталей цветового градиента на самом деле, это самая сложная часть этого.

• использовать функции топологии в rgeos найти сначала замкнутые прямоугольники в вашей фигуре, а затем их дополнение. Построение дополнения с белой заливкой на фоне мытья покрывает цвет везде за исключением внутри полигонов, только то, что вы хотите.

• и, наконец, использовать plot(..., add=TRUE), lines(), abline(), etc. чтобы изложить любые другие детали, которые вы как сюжет для показа.

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)

Это ужасный способ обмануть 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() 

цвета не то, что вы хотели, но это, вероятно, слишком медленно для серьезного использования в любом случае.

другая возможность, которая использует функции из grid и gridSVG пакеты.

мы начинаем с генерации дополнительных точек данных с помощью линейной интерполяции в соответствии с методами, описанными @kohske здесь. Затем базовый участок будет состоять из двух отдельных полигонов, один для отрицательных значений и один для положительных значений.

после сюжета была оказана, grid.ls используется для отображения списка grobs, т. е. весь строительный блок участка. В списке мы (среди прочего) найдем два geom_area.polygons; один, представляющий многоугольник для значений <= 0, и один для значений >= 0.

заливка полигона grobs затем манипулируется с помощью gridSVG функции: пользовательские цветовые градиенты создаются с linearGradient, и заливки grobs заменяются с помощью grid.gradientFill.

манипуляции grob градиенты хорошо описаны в главе 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"))