使用R中的ggplot填充行之间的区域

use*_*544 4 r ggplot2

目标

我试图在用R中的ggplot生成的图中填充两行之间的区域.我想在水平线上方的线之间填充不同于水平线以下的颜色.

我成功地用一种颜色填充两条线之间的所有东西,但是,我没有设法用两种不同的颜色区分垂直线的上方和下方.

set.seed(123) 

# Load packages
library(tidyverse)

# Create sample dataframe
df <- data.frame(x=seq(1,50,1),y=runif(50, min = 0, max = 10))

# Generate plot
ggplot(data = df, aes(x = x, y = y)) +
  geom_line() +
  geom_hline(yintercept = 5) +
  theme_classic() +
  geom_ribbon(aes(ymin=5,ymax=y), fill="blue")
Run Code Online (Sandbox Code Playgroud)

如何用不同的颜色填充垂直线上方和下方的空间?

Z.L*_*Lin 5

您可以计算两条线相交的点的坐标,并将它们添加到数据框中:

m <- 5 # replace with desired y-intercept value for the horizontal line

# identify each run of points completely above (or below) the horizontal
# line as a new section
df.new <- df %>%
  arrange(x) %>%
  mutate(above.m = y >= m) %>%
  mutate(changed = is.na(lag(above.m)) | lag(above.m) != above.m) %>%
  mutate(section.id = cumsum(changed)) %>%
  select(-above.m, -changed)

# calculate the x-coordinate of the midpoint between adjacent sections
# (the y-coordinate would be m), & add this to the data frame
df.new <- rbind(
  df.new,
  df.new %>%
    group_by(section.id) %>%
    filter(x %in% c(min(x), max(x))) %>%
    ungroup() %>%
    mutate(mid.x = ifelse(section.id == 1 | 
                            section.id == lag(section.id), 
                          NA,
                          x - (x - lag(x)) / 
                            (y - lag(y)) * (y - m))) %>% 
    select(mid.x, y, section.id) %>%
    rename(x = mid.x) %>%
    mutate(y = m) %>%
    na.omit())
Run Code Online (Sandbox Code Playgroud)

使用此数据框,您可以定义两个geom_ribbon具有不同颜色的单独图层.比较下面的结果(注意:我还添加了geom_point一层用于说明,并改变了颜色,因为原始的蓝色在眼睛上有点刺眼......)

p1 <- ggplot(df,
             aes(x = x, y = y)) +
  geom_ribbon(aes(ymin=5, ymax=y), fill="dodgerblue") +
  geom_line() +
  geom_hline(yintercept = m) +
  geom_point() + 
  theme_classic()

p2 <- ggplot(df.new, aes(x = x, y = y)) +      
  geom_ribbon(data = . %>% filter(y >= m),
              aes(ymin = m, ymax = y), 
              fill="dodgerblue") +
  geom_ribbon(data = . %>% filter(y <= m),
              aes(ymin = y, ymax = m), 
              fill = "firebrick1") +
  geom_line() +
  geom_hline(yintercept = 5) +
  geom_point() +      
  theme_classic()
Run Code Online (Sandbox Code Playgroud)

结果