Jak wykonać wykres wypełniony gradientem czasu w R

Question

Jak wypełnić obszar pod i nad (sp) linią z kolor gradientu?

Ten przykład został narysowany w Inkscape - ALE POTRZEBUJĘ pionowy gradient - NIE poziomy.

Odstęp od zerowej do pozytywne == z biały do czerwonego.

Odstęp od zerowej do negatywne == z biały do czerwonego.

Czy istnieje pakiet, który mógłby to zrobić?

ja wykonane pewne dane źródłowe ....

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

A oto podejście w base R, gdzie wypełniają całą powierzchnię z prostokątów o stopniowanym kolor, a następnie wypełnić odwrotność obszar zainteresowania z białym.

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() 
} 

Oto kilka przykładów:

xy <- curve(sin, -10, 10, n = 1000) 
shade(xy$x, xy$y, c('white', 'blue'), 1000) 

Albo kolor określony przez palety rampy Kolor:

shade(xy$x, xy$y, heat.colors, 1000) 

I zastosowane do twoich danych, chociaż najpierw interpolujemy punkty do lepszej rozdzielczości (jeśli tego nie zrobimy, gradient nie będzie ściśle zgodny z linią, w której przekracza zero).

xy <- approx(my.spline$x, my.spline$y, n=1000) 
shade(xy$x, xy$y, c('white', 'red'), 1000) 

Answer 2

Oto jedno podejście, które opiera się głównie na kilku pakietów przestrzennych R.

Podstawowym założeniem jest:

• Działka pusta działka, płótno, na którym kolejne elementy zostaną ustanowione. (Wykonanie tego pierwszego umożliwia również pobranie współrzędnych użytkownika wykresu, potrzebnych w kolejnych krokach.)

• Użyj wektorowego połączenia do rect(), aby określić kolor tła. Uzyskanie najdrobniejszych szczegółów gradientu kolorów jest w rzeczywistości najtrudniejszą częścią robienia tego.

• Użyj funkcji topologii w rgeos, aby znaleźć najpierw zamknięte prostokąty na twojej figurze, a następnie ich dopełnienie. Wykreślanie dopełnienia białym wypełnieniem po obmyciu tła powoduje zakrycie koloru wszędzie pod numerem , z wyjątkiem w obrębie wielokątów, co tylko chcesz.

• Wreszcie, należy plot(..., add=TRUE), lines(), abline() itp ustanowić wszelkie inne dane, które chcesz działkę do wyświetlenia.

---

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 3

To jest straszny sposób oszukać ggplot do robienia tego, co chcesz. Zasadniczo tworzę gigantyczną siatkę punktów, które znajdują się pod krzywą. Ponieważ nie ma możliwości ustawienia gradientu w pojedynczym wielokącie, musisz utworzyć osobne wielokąty, a więc siatkę.Będzie działać wolno, jeśli ustawisz zbyt niskie wartości pikseli.

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

Kolory nie są tym, co chciałeś, ale i tak prawdopodobnie jest zbyt powolny, aby użyć go w poważny sposób.

Answer 4

Inną możliwością, która wykorzystuje funkcje z grid i gridSVG pakietów.

Zaczynamy od wygenerowania dodatkowych punktów danych za pomocą interpolacji liniowej, zgodnie z metodami opisanymi przez @kohskehere. Podstawowy wykres będzie składał się z dwóch oddzielnych poligonów, jednego dla wartości ujemnych i jednego dla wartości dodatnich.

Po wyrenderowaniu wykresu, grid.ls jest używany do wyświetlania listy grob s, tj. Całego bloku konstrukcyjnego wykresu. Na liście znajdziemy (między innymi) dwie: geom_area.polygon s; jeden reprezentujący wielokąt dla wartości <= 0, a drugi dla wartości >= 0.

Wypełnienie wielokąta grobs jest następnie manipulować za pomocą gridSVG funkcje: zwyczaj kolor gradienty są tworzone z linearGradient i napełnienia grobs otrzymują użyciu grid.gradientFill.

Manipulacja gradientami grob jest ładnie opisana w rozdziale 7 w MSc thesis Simona Pottera, jednego z autorów pakietu 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") 

Można łatwo tworzyć różne gradienty kolorów dla dodatnich i ujemnych wielokątów. Na przykład.jeśli chcesz wartości ujemne, aby uruchomić z białego na niebieski zamiast wymienić col_pos powyżej:

col_pos <- linearGradient(col = c("white", "blue"), 
          x0 = unit(1, "npc"), x1 = unit(1, "npc"), 
          y0 = unit(0, "npc"), y1 = unit(1, "npc"))