Shading the area between geom_line and the x axis

Question

I have two graphs showing supply and demand, and one graph in which I subtracted demand from supply to show the asymmetry that is emerging. I would like to shade the area between the x axis and the negative part of the asymmetry to show the extent of the deficit.

I am currently using the following 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)) 

However, as expected, this does not obscure the area between geom_line and the x axis, but only between the negative values ​​of the asymmetry data, which is completely different, as shown in the resulting graph:

Is there any way to overcome this problem?

/ Edit: some example data:

 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

What about inspiration. Now you need to add additional data points where the asymmetry is zero (for example, suggested by @baptiste). I create a new column that is NA when the asymmetry is above zero, so geom_ribbon will not be drawn there. Just a subset of the data will not lead to the desired schedule.

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

Some additional notes on how you built your example. Most importantly, R is vectorized. For instance:

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

is equivalent to:

 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 this case, reducing the code is modest, but in other (more realistic) settings using vectorization, dozens of lines of code will be saved.

Answer 2

The following code is ported from Matlab to calculate the intersection between segments. If you apply it between the x axis (fixed) and each pair of consecutive points, you will get a list of new coordinates that indicate the intersection points between your geom_line and x axis. From this, it is an easy step to obscure the corresponding polygons. Please note that I did not check the ported Matlab code correctly.

 ## 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")