3

I would like to create the plot below using ggplot. Does anyone know of any geom that create the shaded region below the line chart? Thank you enter image description here

tjebo
  • 21,977
  • 7
  • 58
  • 94
Afiq Johari
  • 1,372
  • 1
  • 15
  • 28
  • See `help("geom_polygon")` – duckmayr May 13 '20 at 12:45
  • 1
    Other (non-`ggplot`) alternatives: [How to make gradient color filled timeseries plot in R](https://stackoverflow.com/questions/27250542/how-to-make-gradient-color-filled-timeseries-plot-in-r) – Henrik Dec 05 '21 at 16:32

2 Answers2

10

I think you're just looking for geom_area. However, I thought it might be a useful exercise to see how close we can get to the graph you are trying to produce, using only ggplot:

enter image description here

Pretty close. Here's the code that produced it:


Data

library(ggplot2)
library(lubridate)

# Data points estimated from the plot in the question:
points <- data.frame(x = seq(as.Date("2019-10-01"), length.out = 7, by = "month"),
                     y = c(2, 2.5, 3.8, 5.4, 6, 8.5, 6.2))

# Interpolate the measured points with a spline to produce a nice curve:
spline_df   <- as.data.frame(spline(points$x, points$y, n = 200, method = "nat"))
spline_df$x <- as.Date(spline_df$x, origin = as.Date("1970-01-01"))
spline_df   <- spline_df[2:199, ]

# A data frame to produce a gradient effect over the filled area:
grad_df <- data.frame(yintercept = seq(0, 8, length.out = 200), 
                      alpha = seq(0.3, 0, length.out = 200))

Labelling functions

# Turns dates into a format matching the question's x axis
xlabeller <- function(d) paste(toupper(month.abb[month(d)]), year(d), sep = "\n")

# Format the numbers as per the y axis on the OP's graph
ylabeller <- function(d) ifelse(nchar(d) == 1 & d != 0, paste0("0", d), d)

Plot

ggplot(points, aes(x, y)) + 
  geom_area(data = spline_df, fill = "#80C020", alpha = 0.35) + 
  geom_hline(data = grad_df, aes(yintercept = yintercept, alpha = alpha), 
             size = 2.5, colour = "white") +
  geom_line(data = spline_df, colour = "#80C020", size = 1.2) +
  geom_point(shape = 16, size = 4.5, colour = "#80C020") +
  geom_point(shape = 16, size = 2.5, colour = "white") +
  geom_hline(aes(yintercept = 2), alpha = 0.02) +
  theme_bw() +
  theme(panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank(),
        panel.grid.minor.y = element_blank(),
        panel.border       = element_blank(),
        axis.line.x        = element_line(),
        text               = element_text(size = 15),
        plot.margin        = margin(unit(c(20, 20, 20, 20), "pt")),
        axis.ticks         = element_blank(),
        axis.text.y        = element_text(margin = margin(0,15,0,0, unit = "pt"))) +
  scale_alpha_identity() + labs(x="",y="") +
  scale_y_continuous(limits = c(0, 10), breaks = 0:5 * 2, expand = c(0, 0),
                     labels = ylabeller) +
  scale_x_date(breaks = "months", expand = c(0.02, 0), labels = xlabeller)
Allan Cameron
  • 147,086
  • 7
  • 49
  • 87
  • 1
    @Tjebo thank you. I should have reprexed that! I like all your suggestions and have incorporated them. It looks very close now. – Allan Cameron May 13 '20 at 20:22
  • 1
    @AllanCameron thanks Allan, this is pretty overkill for what I expected, but you created the same exact chart! I'm so impressed. In fact the spline interpolation is also very useful for what I'm currently working. Thanks again! – Afiq Johari May 14 '20 at 04:16
  • check this one out:) https://stackoverflow.com/a/64695516/7941188 – tjebo Dec 05 '21 at 15:40
  • 1
    Another cracker from Teun, @tjebo. We've been working on a package together to properly implement curved text in ggplot. It's hopefully not too far from production standard: https://github.com/AllanCameron/geomtextpath – Allan Cameron Dec 05 '21 at 17:28
  • Ive seen that. it’s amazing! – tjebo Dec 05 '21 at 19:51
1

You can use geom_area_pattern from ggpattern to create a gradient polygon without having to create a separate dataframe, with the added benefit of it rendering nicely at different resolutions. The trick is to specify fully transparent colours for the background and one of the pattern fills (code adapted from @Tjebo's excellent answer):

library(ggplot2)
library(lubridate)
library(ggpattern)

# Data points estimated from the plot in the question:
points <- data.frame(x = seq(as.Date("2019-10-01"), length.out = 7, by = "month"),
                     y = c(2, 2.5, 3.8, 5.4, 6, 8.5, 6.2))

# Interpolate the measured points with a spline to produce a nice curve:
spline_df   <- as.data.frame(spline(points$x, points$y, n = 200, method = "nat"))
spline_df$x <- as.Date(spline_df$x, origin = as.Date("1970-01-01"))
spline_df   <- spline_df[2:199, ]

# Turns dates into a format matching the question's x axis
xlabeller <- function(d) paste(toupper(month.abb[month(d)]), year(d), sep = "\n")

# Format the numbers as per the y axis on the OP's graph
ylabeller <- function(d) ifelse(nchar(d) == 1 & d != 0, paste0("0", d), d)

# Make the plot
ggplot(points, aes(x, y)) + 
  ggpattern::geom_area_pattern(data = spline_df,
                               pattern = "gradient", 
                               fill = "#00000000",
                               pattern_fill  = "#00000000",
                               pattern_fill2 = "#80C02080") + #prepended w/ 50% transparency hex code (80)
  geom_line(data = spline_df, colour = "#80C020", size = 1.2) +
  geom_point(shape = 16, size = 4.5, colour = "#80C020") +
  geom_point(shape = 16, size = 2.5, colour = "white") +
  geom_hline(aes(yintercept = 2), alpha = 0.02) +
  theme_bw() +
  theme(panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank(),
        panel.grid.minor.y = element_blank(),
        panel.border       = element_blank(),
        axis.line.x        = element_line(),
        text               = element_text(size = 15),
        plot.margin        = margin(unit(c(20, 20, 20, 20), "pt")),
        axis.ticks         = element_blank(),
        axis.text.y        = element_text(margin = margin(0,15,0,0, unit = "pt"))) +
  scale_alpha_identity() + labs(x="",y="") +
  scale_y_continuous(limits = c(0, 10), breaks = 0:5 * 2, expand = c(0, 0),
                     labels = ylabeller) +
  scale_x_date(breaks = "months", expand = c(0.05, 0), labels = xlabeller)
sketchkey
  • 11
  • 1