Question

我有两个显示供需的图，还有一个图，其中我减去了供应的需求以显示产生的不对称性。我想遮蔽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轴之间的区域，而只会遮挡不对称数据的负值，这完全不同，如结果图所示：

enter image description here

有没有办法克服这个问题？

/编辑：一些示例数据：

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

下面是一些代码ported from Matlab来计算段之间的交集。如果在x轴（固定）和每对连续点之间应用它，则会得到一个新坐标列表，指示geom_line和x轴之间的交叉点。从中可以轻松地对相关多边形进行着色。请注意，我没有正确测试移植的Matlab代码。

enter image description here

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

Answer 2

这是什么灵感。现在，您只需要添加不对称性等于零的其他数据点（如@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")

enter image description here

关于您构建示例的方式的一些其他说明。最重要的一点是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

在这种情况下，代码的减少是适度的，但在其他（更现实的）设置中使用矢量化将为您节省数十行代码。

在geom_line和x轴之间着色区域

2 个答案: