ggplot2 se=TRUE for stat_smooth in facet_grid dependent on if statement

Question

I am trying to get standard error to plot on a graph given a criteria. I want it to show for some graphs and not for others and I'm trying to use an if statement inside the stat_smooth to make this happen:

library(ggplot2)
ggplot(diamonds, aes(depth, price)) + 
  stat_smooth(method="glm", se = ifelse(color == "I", FALSE, TRUE), formula=y~x,
          alpha=0.2, size=1, aes(fill=cut)) +
  facet_grid(.~ color)

However, it doesn't appear to recognise the color variable:

Error in ifelse(color == "I", FALSE, TRUE) : object 'color' not found

I also tried mapping a variable to hold this true and false value:

library(dplyr)

diamonds <- diamonds %>% mutate(SE = ifelse(color=="I", FALSE, TRUE))

ggplot(diamonds, aes(depth, price, colour=SE)) + 
  stat_smooth(method="glm", se = SE, formula=y~x,
          alpha=0.2, size=1, aes(fill=cut)) +
  facet_grid(.~ color)

R has no idea how to find `color`. the code inside the `stat_smooth()` that handles the `se` parameter does not check within the `diamonds` parent frame for data. Since there is no `color` in the global environment R has no idea how to handle this. You also cannot map `se` to an aesthetic since it's just a parameter. — hrbrmstr, Oct 17 '18 at 16:29
is there no way to pass things from gpplot(....) to + stat_smooth? It obviously pulls x and y. See my second attempt above — pluke, Oct 17 '18 at 16:38
So, as I noted, `se` is a parameter, not an aesthetic mapping (ref: https://github.com/hrbrmstr/ggplot2/blob/master/R/stat-smooth.r#L57 / https://github.com/hrbrmstr/ggplot2/blob/master/R/stat-smooth.r#L99). As a result, you can't put it into an `aes()`. Note also that the formula gets passed (https://github.com/hrbrmstr/ggplot2/blob/master/R/stat-smooth.r#L98) into the evaluator but it already has `x` and `y` mapped via your `ggplot(diamonds, aes(depth, price))` call. The only way to do what you want (which is not an unreasonable request IMO) is to PR a fix into ggplot2 or file an issue. — hrbrmstr, Oct 17 '18 at 16:43

score 2 · Answer 1 · answered Oct 17 '18 at 16:37

You can manually achieve what you want via:

library(ggplot2)
library(gridExtra)

colors <- unique(diamonds$color)
do.call(grid.arrange, lapply(colors, function(color) {
  ggplot(diamonds[diamonds$color == color,], aes(depth, price)) + 
    stat_smooth(method="glm", se = (color != "I"), formula=y~x,
                alpha=0.2, size=1, aes(fill=cut)) +
    scale_x_continuous(limits=c(40, 80)) +
    scale_y_continuous(limits=c(0,10000)) -> gg
  if (color != colors[length(colors)]) gg + theme(legend.position = "none") else gg
}))

And do some grob hacking with something like < Add a common Legend for combined ggplots > to have a common legend non-in-plot and keep the plots uniform.

great solution, will accept it if there really is no way to do this in ggplot itself — pluke, Oct 17 '18 at 16:41

score 2 · Accepted Answer · answered Oct 17 '18 at 16:53

Keeping this separate b/c it's long. You can also write a custom version of stat_smooth/StatSmooth:

stat_smooth2 <- function(mapping = NULL, data = NULL,
                        geom = "smooth", position = "identity",
                        ...,
                        method = "auto",
                        formula = y ~ x,
                        se = TRUE,
                        n = 80,
                        span = 0.75,
                        fullrange = FALSE,
                        level = 0.95,
                        method.args = list(),
                        na.rm = FALSE,
                        show.legend = NA,
                        inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = StatSmooth2,
    geom = geom,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      method = method,
      formula = formula,
      se = se,
      n = n,
      fullrange = fullrange,
      level = level,
      na.rm = na.rm,
      method.args = method.args,
      span = span,
      ...
    )
  )
}

StatSmooth2 <- ggproto("StatSmooth", Stat,

  setup_params = function(data, params) {
    if (identical(params$method, "auto")) {
      # Use loess for small datasets, gam with a cubic regression basis for
      # larger. Based on size of the _largest_ group to avoid bad memory
      # behaviour of loess
      max_group <- max(table(interaction(data$group, data$PANEL, drop = TRUE)))

      if (max_group < 1000) {
        params$method <- "loess"
      } else {
        params$method <- "gam"
        params$formula <- y ~ s(x, bs = "cs")
      }
      message("`geom_smooth()` using method = '", params$method, 
              "' and formula '", deparse(params$formula), "'")
    }
    if (identical(params$method, "gam")) {
      params$method <- mgcv::gam
    }

    params
  },

  compute_group = function(data, scales, method = "auto", formula = y~x,
                           se = TRUE, n = 80, span = 0.75, fullrange = FALSE,
                           xseq = NULL, level = 0.95, method.args = list(),
                           na.rm = FALSE) {
    if (length(unique(data$x)) < 2) {
      # Not enough data to perform fit
      return(data.frame())
    }

    if (is.null(data$weight)) data$weight <- 1

    if (is.null(xseq)) {
      if (is.integer(data$x)) {
        if (fullrange) {
          xseq <- scales$x$dimension()
        } else {
          xseq <- sort(unique(data$x))
        }
      } else {
        if (fullrange) {
          range <- scales$x$dimension()
        } else {
          range <- range(data$x, na.rm = TRUE)
        }
        xseq <- seq(range[1], range[2], length.out = n)
      }
    }
    # Special case span because it's the most commonly used model argument
    if (identical(method, "loess")) {
      method.args$span <- span
    }

    if (is.character(method)) method <- match.fun(method)

    base.args <- list(quote(formula), data = quote(data), weights = quote(weight))
    model <- do.call(method, c(base.args, method.args))

    se <- data$secol[1] != "I"

    ggplot2:::predictdf(model, xseq, se, level)
  },

  required_aes = c("x", "y", "secol")
)

Then do what you want:

library(ggplot2)
ggplot(diamonds, aes(depth, price)) + 
  stat_smooth2(method="glm", formula=y~x,
          alpha=0.2, size=1, aes(fill=cut, secol = color)) + # << NOTE secol
  facet_grid(.~ color)

which gives:

This is prbly less "meh" & frustrating than hacking grobs for legends.

ggplot2 se=TRUE for stat_smooth in facet_grid dependent on if statement

2 Answers2