Plotting the 95% error margin segments of the fitted line and controlling the line properties

Question

Using the geom_smooth function in ggplot2 it cannot control the se boundaries for linetype and linewidth, is there a simpler way to achieve the following figure:

Method 1: Use the repeated computation method to do and plot using geom = ribbon:

library(tidyverse)

ggplot(data = mpg, aes(x = displ,y = hwy))+
  geom_point()+
  geom_smooth(method = "lm", se = FALSE, color = "black") +
  stat_smooth(method = "lm", 
              geom = 'ribbon',
              fill = NA,
              linetype = 2,
              se = TRUE, color = "blue") 

Answer 1

There's nothing simpler out-of-the-box in ggplot than the code you have already demonstrated. From the comments it sounds like you might like a new Geom that does what you ask.

We can write a new Geom (let's call it GeomSmooth2) and have it include three new aesthetics: "ribbon_linetype", "ribbon_colour" and "ribbon_linewidth". This is then invoked by a function called geom_smooth2

Your plotting code would then be something like this, with only a single regression calculation:

ggplot(data = mpg, aes(x = displ, y = hwy)) +
  geom_point() +
  geom_smooth2(method = "lm", se = TRUE, formula = y ~ x, fill = NA,
               ribbon_linetype = 2, ribbon_colour = "blue", ribbon_linewidth = 1) 

You would need to be careful with the new aesthetics because none of them have scales to map to. This means you either need to specify them directly outside of aes (as above) or, if you want to plot multiple groups in one call, you need to ensure that you pre-calculate the values you want each group to have:

mpg %>% 
  mutate(cyl = factor(cyl)) %>%
  mutate(col = c("red", "yellow", "blue", "green")[as.numeric(cyl)]) %>%
  ggplot(aes(x = displ, y = hwy)) +
  geom_point() +
  geom_smooth2(aes(ribbon_colour = col),
               method = "lm", se = TRUE, formula = y ~ x, fill = NA,
               ribbon_linetype = 2, ribbon_linewidth = 1) 

To get this working you need a new Geom object:

GeomSmooth2 <- ggplot2::ggproto("smooth2", ggplot2::GeomSmooth,
    default_aes = ggplot2::aes(
      colour    = "black",
      fill      = "grey60",
      linewidth = 1,
      linetype  = 1,
      weight    = 1,
      ribbon_colour = "black",
      ribbon_linewidth = 0.5,
      ribbon_linetype = 1,
      alpha     = 0.4),
    draw_group = function (data, panel_params, coord, lineend = "butt", 
                           linejoin = "round", 
                           linemitre = 10, se = FALSE, flipped_aes = FALSE) 
    {
      ribbon <- transform(data, colour = data$ribbon_colour,
                          linewidth = data$ribbon_linewidth,
                          linetype = data$ribbon_linetype)
      path <- transform(data, alpha = NA)
      ymin = ggplot2::flipped_names(flipped_aes)$ymin
      ymax = ggplot2::flipped_names(flipped_aes)$ymax
      has_ribbon <- se && !is.null(data[[ymax]]) && !is.null(data[[ymin]])
      grid::gList(if (has_ribbon) 
        ggplot2::GeomRibbon$draw_group(ribbon, panel_params, coord, 
                                       flipped_aes = flipped_aes), 
        ggplot2::GeomLine$draw_panel(path, panel_params, coord, 
                                     lineend = lineend, 
                                     linejoin = linejoin, 
                                     linemitre = linemitre))
    }
)

and you need the actual function that invokes it:

geom_smooth2 <- function (mapping = NULL, data = NULL, stat = "smooth", 
                          position = "identity", ..., na.rm = FALSE, 
                          show.legend = NA, inherit.aes = TRUE) 
{
  ggplot2::layer(data = data, mapping = mapping, stat = stat, 
                 geom = GeomSmooth2, 
                 position = position, 
                 show.legend = show.legend, 
                 inherit.aes = inherit.aes, 
                 params = rlang::list2(na.rm = na.rm, ...))
}

I haven't taken the trouble to write a draw_key method, so note that there is no legend in the case that you want multiple groups labelled.