Fix for geom_ribbon()

[robwschlegel]

Hello,
Firstly, thank you for providing the world with the ggplot2 package and broader tidyverse ecosystem of packages. It has revolutionised the way people use R and it is the only method I use now when introducing my new students to the language.
I work in climate science and so have a series of requirements for visuals that are perhaps a bit different than data science more broadly. One of these is the necessity to be able to visualise values that are in excess of a given threshold. One would normally use the geom_ribbon() function to accomplish this, but it is my understanding that this function does not have the capability to allow users to choose to fill in the area only above or below one of the given lines (i.e. ymin or ymax). There are multiple posts on stack overflow etc. about this and the work arounds provided do not create very nice figures. Specifically I mean that the corners of the polygons are not satisfactorily filled in. For this reason I went about creating a fix for this issue. The geom I created is called geom_flame() and may be found in my package heatwaveR, which is on CRAN. I have also written the necessary code to allow this geom to work in an interactive plotly environment.
If it would be deemed appropriate I would be happy for my source code to be included in ggplot2 in part or in full, as necessary. Below please find a reprex highlighting the differences between geom_flame() and geom_ribbon(). I did not include a reprex for use in plotly as I don't think that works in GitHub(?).
All the best,
-Robert Schlegel

# Load libraries
library(ggplot2)
library(heatwaveR)

# Detect the marine heatwaves in a time series
ts <- ts2clm(sst_WA, climatologyPeriod = c("1982-01-01", "2011-12-31"))
mhw <- detect_event(ts)

# Grab a subset of data
data_stub <- mhw$climatology[10580:10720,]

# Visualise with geom_ribbon
ribbon_plot <- ggplot(data_stub, aes(x = t, ymin = temp, ymax = thresh)) +
  geom_ribbon(fill = "salmon") +
  geom_line(aes(y = temp)) +
  geom_line(aes(y = thresh), colour = "darkgreen")

# Visualise with geom_flame
flame_plot <- ggplot(data_stub, aes(x = t, y = temp, y2 = thresh)) +
  geom_flame() +
  geom_line() +
  geom_line(aes(y = thresh), colour = "darkgreen")

# Stick them next to each other
cowplot::plot_grid(ribbon_plot, flame_plot, ncol = 1)

[paleolimbot]

Rendered reprex:

# Load libraries
library(ggplot2)
library(heatwaveR)

# Detect the marine heatwaves in a time series
ts <- ts2clm(sst_WA, climatologyPeriod = c("1982-01-01", "2011-12-31"))
mhw <- detect_event(ts)

# Grab a subset of data
data_stub <- mhw$climatology[10580:10720,]

# Visualise with geom_ribbon
ribbon_plot <- ggplot(data_stub, aes(x = t, ymin = temp, ymax = thresh)) +
  geom_ribbon(fill = "salmon") +
  geom_line(aes(y = temp)) +
  geom_line(aes(y = thresh), colour = "darkgreen")

# Visualise with geom_flame
flame_plot <- ggplot(data_stub, aes(x = t, y = temp, y2 = thresh)) +
  geom_flame() +
  geom_line() +
  geom_line(aes(y = thresh), colour = "darkgreen")

# Stick them next to each other
cowplot::plot_grid(ribbon_plot, flame_plot, ncol = 1)

^{Created on 2019-07-14 by the reprex package (v0.2.1)}

[yutannihilation]

Isn't this enough?

# Load libraries
library(ggplot2)
library(heatwaveR)

# Detect the marine heatwaves in a time series
ts <- ts2clm(sst_WA, climatologyPeriod = c("1982-01-01", "2011-12-31"))
mhw <- detect_event(ts)

# Grab a subset of data
data_stub <- mhw$climatology[10580:10720,]

# Visualise with geom_ribbon
ggplot(data_stub, aes(x = t, ymax = pmax(thresh, temp), ymin = thresh)) +
  geom_ribbon(fill = "salmon") +
  geom_line(aes(y = temp)) +
  geom_line(aes(y = thresh), colour = "darkgreen")

[robwschlegel]

Hello,
That is an interesting fix I hadn't seen before. It is not perfect though and one may still see some artifacts at the bottom corners of the polygons where they fall above the dark green line. This is better than I have seen elsewhere, but is still enough of an issue that this figure would not be acceptable for publication.

I've created a zoomed in example below to better highlight this problem, and to demonstrate how geom_flame() correctly addresses it. I've also included in the example the use of the n = x argument that allows the user to choose not to fill in polygons that have below a certain number of points.

# Libraries
library(tidyverse)
library(heatwaveR)

# Detect the marine heatwaves in a time series
ts <- ts2clm(sst_WA, climatologyPeriod = c("1982-01-01", "2011-12-31")) %>% 
  mutate(thresh = thresh+0.7)
mhw <- detect_event(ts)

# Grab a subset of data
data_stub <- mhw$climatology[10580:10630,]

# Visualise with geom_ribbon
ribbon_plot <- ggplot(data_stub, aes(x = t, ymax = pmax(thresh, temp), ymin = thresh)) +
  geom_ribbon(fill = "salmon") +
  geom_line(aes(y = temp)) +
  geom_line(aes(y = thresh), colour = "darkgreen")

# Visualise with geom_ribbon
flame_plot <- ggplot(data_stub, aes(x = t, y = temp, y2 = thresh)) +
  geom_flame(n = 5) + # Choose not to fill in polygons with five or fewer points
  geom_line(aes(y = temp)) +
  geom_line(aes(y = thresh), colour = "darkgreen")

# Stick them together
  # NB: Note the incorrect fill on the corners of the ribbon plot polygons
cowplot::plot_grid(ribbon_plot, flame_plot, ncol = 1)

[yutannihilation]

Yes, we need to interpolate the data to determine the intersect points, which you do here:

https://github.com/robwschlegel/heatwaveR/blob/b40d354af0080882963a21dbaea5fa0310849838/R/geoms.R#L163-L172

I don't mean I'm against your idea at all, but, I'm wondering if this is really ggplot2's role to provide such kind of Stat or Geom.

(BTW, please render the reprex...)

[robwschlegel]

Hello,
If you are happy with geom_ribbon() not being able to do this, and you also don't want to provide any alternative in ggplot2 I am fine with that. I just thought you may want to consider it. I'm happy for this issue to be closed then.

Also, how does one run a reprex in a GitHub comment box? I read the documentation at: https://reprex.tidyverse.org/ but did not find it clear.

All the best,
-Robert

[karawoo]

Thanks @robwschlegel! My personal opinion is that the geom itself would be too specialized for ggplot2, but that we should fix the issue of the filled area extending past the line. I noticed that as well in #3390.

To render a reprex, you write the code and copy it to the clipboard, then run reprex::reprex() in an R console. That function runs the code and puts the code + output on your clipboard in a format that GitHub will display nicely. So after running reprex::reprex(), paste whatever is in your clipboard into the GitHub comment.

[robwschlegel]

Thanks @karawoo! I was playing around with the reprex code but it wasn't behaving like I expected. Good to know that it works a bit different than I was thinking.
I agree that geom_flame() is too specialised for ggplot2, but perhaps the way in which it correctly adjusts the corners of the polygons should be included in geom_ribbon().
W.r.t. the difference between geom_ribbon() and geom_flame(), the latter geom calculates the angles at which y and ymax are going to intercept, which is how it avoids the corners popping out too much.
Would you like to close this issue?

[yutannihilation]

I think you can keep this open. At least, I'm curious about how this issue should be addressed.

In my understanding, this is a matter of resolution and should be fixed by simple interpolation (IMHO, it's not necessary to calculate the exact intercept points to make the plot visually sound). For example, we can use approx() like this:

library(ggplot2)

d <- data.frame(
  x = 1:20,
  y = c(-1, -2, 1, 3, 4, 5, 2, -1, -1, -3, -2, 4, 5, 5, 4, 3, 1, -2, 1, -1)
)

ggplot(d, aes(x, y)) +
  geom_ribbon(aes(ymax = pmax(y, 0), ymin = 0), fill = "pink", alpha = 0.5) +
  geom_path()

interpolate <- function(data, ...) {
  x_range <- range(data$x)
  x <- seq(x_range[1], x_range[2], length.out = 10000)
  as.data.frame(approx(data$x, data$y, x))
}

ggplot(d, aes(x, y)) +
  geom_ribbon(data = interpolate, aes(ymax = pmax(y, 0), ymin = 0), fill = "pink", alpha = 0.5) +
  geom_path()

I'm not yet sure if it's a good idea to do interpolation in the drawing phase, but I like your idea. Interpolation is one of the missing features in ggplot2. For example, #2883 (comment) seems another issue to be addressed by interpolating data.

[paleolimbot]

Would a StatAlign (maybe with a different name) using @yutannihilation's code above be a good solution to this and #2883? There is some code in StatFunction that creates an equally-spaced grid with n points along scales$x$dimension() that might be helpful. I think the layer call could then be collapsed to geom_ribbon(aes(pmax(y, 0), ymin = 0), stat = "align") (maybe with a stat() somewhere in there?).

[yutannihilation]

StatAlign sounds nice.

[yutannihilation]

Closed by #4889.

library(ggplot2)

d <- data.frame(
  x = 1:20,
  y = c(-1, -2, 1, 3, 4, 5, 2, -1, -1, -3, -2, 4, 5, 5, 4, 3, 1, -2, 1, -1)
)

ggplot(d, aes(x, y)) +
  geom_ribbon(
    aes(ymax = pmax(after_stat(y), 0), ymin = 0),
    fill = "pink",
    alpha = 0.5,
    stat = "align"
  ) +
  geom_path()

^{Created on 2022-07-07 by the reprex package (v2.0.1)}

[jkdel]

It appears to me that setting the threshold/lower limit at 0 is a special case (effectively fixed by StatAlign) but that the issue still persists. @yutannihilation's solution remains effective in those cases.

library(ggplot2)
library(patchwork)

d <- data.frame(
  x = 1:20,
  y = c(-1, -2, 1, 3, 4, 5, 2, -1, -1, -3, -2, 4, 5, 5, 4, 3, 1, -2, 1, -1)
)

p0 <- (ggplot(d, aes(x, y)) +
  geom_ribbon(
    aes(ymax = pmax(after_stat(y), 0), ymin = 0),
    fill = "pink",
    alpha = 0.5,
    stat = "align"
  ) +
  geom_path() +
  labs(title = "StatAlign at threshold 0"))

p2 <- (ggplot(d, aes(x, y)) +
  geom_ribbon(
    aes(ymax = pmax(after_stat(y), 2), ymin = 2),
    fill = "pink",
    alpha = 0.5,
    stat = "align"
  ) +
  geom_path() +
  labs(title = "StatAlign at threshold 2"))

interpolate <- function(data, ...) {
  x_range <- range(data$x)
  x <- seq(x_range[1], x_range[2], length.out = 10000)
  as.data.frame(approx(data$x, data$y, x))
}

p2i <- (ggplot(d, aes(x, y)) +
         geom_ribbon(
           data = interpolate,
           aes(ymax = pmax(y, 2), ymin = 2),
           fill = "pink",
           alpha = 0.5
         ) +
         geom_path() +
         labs(title = "Interpolate at threshold 2"))

p0/p2/p2i

^{Created on 2023-04-30 with reprex v2.0.2}