Schattierung eines Bereichs zwischen Geom_line und der X-Achse

Question

Ich habe zwei Plots, die Angebot und Nachfrage anzeigen, und ein Plot, in dem ich die Nachfrage von der Versorgung subtrahiert habe, um die resultierende Asymmetrie zu zeigen. Ich möchte den Bereich zwischen der x-Achse und dem negativen Teil der Asymmetrie beschatten, um das Ausmaß des Defizits zu zeigen.

Ich verwende derzeit den folgenden Code:

plot.asymmetry <- ggplot(data=df.overview.month, 
         aes(x=Date.Time, y=Asymmetry)) +  
     geom_area(data=subset(df.overview.month, Asymmetry < 0),  
         aes(x=Date.Time, y=Asymmetry)) 

jedoch - wie zu erwarten war - dies nicht Schatten der Bereich zwischen geom_line und der x-Achse, sondern nur zwischen negativen Werte der Asymmetrie Daten, die etwas ganz anderes ist, als in der resultierenden Grafik dargestellt:

gibt es eine Möglichkeit, dieses Problem zu überwinden?

/Edit: einige Beispieldaten:

time.initial <- as.POSIXct("2010-12-31 23:00:00", tz="GMT") 
Date.Time<-vector() 
for(i in 1:24) { 
Date.Time[i] <- time.initial + i*3600 
} 

Demand<-vector() 
for(i in 0:23) { 
Demand[i+1] <- 155 + 20*sin((pi/12)*i - (pi/2)) + 10*sin((pi/4380)*i + (pi/2)) 
} 

Supply<-vector() 
for(i in 0:23) { 
Supply[i+1] <- 165 + 5*sin((pi/4380)*i - (pi/2)) + rnorm(1, mean=0, sd=0.20*165) 
} 

df.overview.month <- data.frame(Date.Time, Demand, Supply, Asymmetry=Supply-Demand) 

Answer 1

Was dies als Inspiration. Jetzt müssen Sie nur zusätzliche Datenpunkte hinzufügen, bei denen die Asymmetrie gleich Null ist (wie @baptiste vorgeschlagen). Ich erstelle eine neue Spalte, die NA ist, wenn die Asymmetrie über Null ist, auf diese Weise wird kein geom_ribbon dort gezeichnet. Nur die Unterteilung der Daten führt nicht zum erforderlichen Plot.

df.overview.month$Assym_ribbon = ifelse(df.overview.month$Asymmetry > 0, 
             NA, 
             df.overview.month$Asymmetry) 
ggplot(aes(x = Date.Time, y = Asymmetry), 
     data = df.overview.month) + 
    geom_line() + 
    geom_ribbon(aes(ymin = 0, ymax = Assym_ribbon), 
     data = , fill = "red") 

Einige zusätzliche Hinweise über die Art und Weise Sie Ihr Beispiel aufgebaut. Der wichtigste ist, dass R vektorisiert ist. Zum Beispiel:

set.seed(1) 
Supply<-vector() 
for(i in 0:23) { 
    Supply[i+1] <- 165 + 
      5*sin((pi/4380)*i - 
      (pi/2)) + 
      rnorm(1, mean=0, sd=0.20*165) 
} 

entsprechen:

set.seed(1) 
i = 0:23 
Supply_vec <- 165 + 5*sin((pi/4380)*i - 
       (pi/2)) + 
       rnorm(length(i), mean=0, sd=0.20*165) 

> all.equal(Supply_vec, Supply) 
[1] TRUE 

In diesem Fall in Code die Reduktion bescheiden ist, aber in anderen (realistischen) Einstellungen Vektorisierung verwendet werden Ihnen Dutzende von Codezeilen speichern.

Answer 2

Unten ist ein Code ported from Matlab, um den Schnittpunkt zwischen Segmenten zu berechnen. Wenn Sie es zwischen der x-Achse (fest) und jedem Paar aufeinander folgender Punkte anwenden, erhalten Sie eine Liste neuer Koordinaten, die die Kreuzungspunkte zwischen Ihrer geom_line und der x-Achse angeben. Von daher ist es ein einfacher Schritt, um die relevanten Polygone zu schattieren. Beachten Sie, dass ich den portierten Matlab-Code nicht richtig getestet habe.

## Ported from Matlab to R 
## Copyright (c) 2010, U. Murat Erdem 
## All rights reserved. 
## http://www.mathworks.com/matlabcentral/fileexchange/27205 
lineSegmentIntersect <- function(XY1, XY2){ 

    n_rows_1 <- nrow(XY1) 
    n_cols_1 <- ncol(XY1) 
    n_rows_2 <- nrow(XY2) 
    n_cols_2 <- ncol(XY2) 

    stopifnot(n_cols_1 == 4 && n_cols_2 == 4) 

    nc <- n_rows_1 * n_rows_2 
    X1 <- matrix(XY1[,1], nrow=nc, ncol=1) 
    X2 <- matrix(XY1[,3], nrow=nc, ncol=1) 
    Y1 <- matrix(XY1[,2], nrow=nc, ncol=1) 
    Y2 <- matrix(XY1[,4], nrow=nc, ncol=1) 

    XY2 <- t(XY2) 

    X3 <- matrix(XY2[1,], nrow=nc, ncol=1) 
    X4 <- matrix(XY2[3,], nrow=nc, ncol=1) 
    Y3 <- matrix(XY2[2,], nrow=nc, ncol=1) 
    Y4 <- matrix(XY2[4,], nrow=nc, ncol=1) 

    X4_X3 <- X4-X3 
    Y1_Y3 <- Y1-Y3 
    Y4_Y3 <- Y4-Y3 
    X1_X3 <- X1-X3 
    X2_X1 <- X2-X1 
    Y2_Y1 <- Y2-Y1 

    numerator_a <- X4_X3 * Y1_Y3 - Y4_Y3 * X1_X3 
    numerator_b <- X2_X1 * Y1_Y3 - Y2_Y1 * X1_X3 
    denominator <- Y4_Y3 * X2_X1 - X4_X3 * Y2_Y1 

    u_a <- numerator_a/denominator 
    u_b <- numerator_b/denominator 

    INT_X <- X1 + X2_X1 * u_a 
    INT_Y <- Y1 + Y2_Y1 * u_a 
    INT_B <- (u_a >= 0) & (u_a <= 1) & (u_b >= 0) & (u_b <= 1) 
    PAR_B <- denominator == 0 
    COINC_B <- (numerator_a == 0 & numerator_b == 0 & PAR_B) 

    data.frame(x=INT_X[INT_B], y=INT_Y[INT_B]) 

} 


set.seed(123) 
x <- sort(runif(50, -10, 10)) 
y <- jitter(sin(x), a=2) 
n <- length(x) 
xy1 <- matrix(c(-10, 0, 10, 0), ncol=4) 
xy2 <- cbind(x[-n], y[-n], x[-1], y[-1]) 
test <- lineSegmentIntersect(xy1, xy2) 

library(ggplot2) 
d <- data.frame(x=x, y=y) 
d2 <- rbind(d, test) 
d2 <- subset(d2[order(d2$x), ], y <=0) 
p <- qplot(x, y, data=d, geom="path") 

p + geom_ribbon(data=d2, aes(ymin = 0, ymax = y), fill="red")