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

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

r colors

如何在R中绘制渐变色填充时间序列图,r,colors,time-series,gradient,R,Colors,Time Series,Gradient,如何使用渐变颜色填充（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

如何使用渐变颜色填充（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)

set.seed（1）这里有一种方法，它严重依赖于几个R空间包其基本思想是：绘制一个空的绘图，画布上的后续元素将被放置。（首先执行此操作还可以检索后续步骤所需的绘图用户坐标。）使用对rect（）的矢量化调用来设置背景色。获取色彩渐变的精细细节实际上是最棘手的部分使用rgeos中的拓扑函数，首先查找图形中的闭合矩形，然后查找它们的补码。在背景上绘制带有白色填充的补色可以覆盖除多边形之外的所有颜色，这正是您想要的最后，使用plot（…，add=TRUE），lines（），abline（），等等，来列出您希望绘图显示的任何其他细节库（sp）图书馆（rgeos）图书馆（光栅）图书馆（网格） ##提取一些坐标 x这是一种欺骗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() gen.bar这里是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另一种可能使用grid 和gridSVG 包中的函数我们首先根据@描述的方法，通过线性插值生成额外的数据点。基本绘图将由两个单独的多边形组成，一个用于负值，一个用于正值绘制完绘图后，grid.ls 用于显示grob s的列表，即绘图的所有构建块。在列表中，我们将（除其他外）找到两个geom_面积.polygon s；一个表示值=0 的多边形然后使用gridSVG 函数操作多边形grobs 的填充：使用linearGradient 创建自定义颜色渐变，并使用grid.gradientFill 替换grobs 的填充 gridSVG 包的作者之一西蒙·波特的著作中的第7章很好地描述了grob 梯度的操作 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") 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) 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 <- linearGradient(col = c("white", "blue"), x0 = unit(1, "npc"), x1 = unit(1, "npc"), y0 = unit(0, "npc"), y1 = unit(1, "npc"))