geom_lineとx軸の間の領域を陰影付けする

Question

私は、需要と供給を表示する2つのプロットと、結果として生じる非対称性を示すために需要を差し引いた1つのプロットを持っています。私は赤字の程度を示すために、x軸とアシンメトリーの負の部分との間の領域を陰にしたいと思います。

私は現在、以下のコードを使用

：ただし

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

を - 期待することができるように - これはgeom_lineとx軸との間、だけ非対称データの負の値との間の影領域をせず、結果のグラフに示すように、何か他のものは、完全に次のとおりです。

この問題を克服する方法はありますか？

/編集：いくつかの例のデータ：インスピレーションとして

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

これは何について。これで、非対称性がゼロに等しい（@baptisteのように）データポイントを追加するだけです。アシンメトリーがゼロを超えると、NAという新しい列が作成されます。この方法では、そこにはgeom_ribbonが描画されません。データのサブセットを設定しても、必要なプロットは作成されません。

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

あなたはあなたの例を構築方法についていくつかの追加の注意事項。最も重要なのは、Rがベクトル化されていることです。たとえば：

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

は同等です：

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 

この場合、コードの減少は緩やかであるが、他の（より現実的な）設定でベクトル化はあなたのコードの行数十を保存します使用します。

Answer 2

以下は、セグメント間の交差を計算するためのコードported from Matlabです。 x軸（固定）と連続する各点のペアの間に適用すると、geom_lineとx軸の間の交差点を示す新しい座標のリストが得られます。これから、関連するポリゴンをシェーディングするのは簡単なステップです。私は、移植されたMatlabコードを適切にテストしていないことに注意してください。

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