Stripping mapping such as colour and line type from an existing ggplot2 object to re-do it

Question

Within a Shiny application, I would like to provide users the option to select a regression method and then show the fit on their data on an existing ggplot2 graph (showing the original data as a geom_step) --> so the graph already exists!

There is a restriction on this graph as colours and line types are mapped to two crossed variables. Yet the combination between the variables ought to be shown as 1 legend item.

This is the dummy data:

library(tidyverse)
createGroup <- function(group, category, effect){
  x <- seq(1,10)
  data.frame(
      time = x,
      y = effect * x + rnorm(10, mean = 0, sd = 0.1),
      group = group,
      cat = category
  )
}
set.seed(12)
ipt <- list(group = paste0('Arm ', rep(c(1,2), each = 2)),
    category = rep(LETTERS[1:2], 2),
    effect = c(0.04, 0.09, 0.35, 0.45))
tmp <- lapply(1:4, \(x) do.call(createGroup, 
          list(group = ipt$group[x], category = ipt$category[x], effect = ipt$effect[x])))
DF <- do.call('rbind', tmp)
DF$group <- factor(DF$group)

# To combine legends, pasting the group and category so that colour and line type
# can be mapped
DF$combined <- paste0(DF$group, ' & cat ', DF$cat)
DF

Producing this graph:

p1 <- ggplot(DF, aes(x = time, y = y)) +
    geom_step(aes(colour = combined, linetype = combined)) +
    scale_colour_manual('', values = c('red', 'red', 'blue', 'blue'),
        breaks = unique(DF$combined)) +
    scale_linetype_manual('', values = c(1,2,1,2),
        breaks = unique(DF$combined)) +
    theme_classic()
p1

Now fitting a linear regression in each combined group:

getPred <- function(x, id, method){
  fit <- lm(y ~ time, data = data.frame(x))
  data.frame(y = predict(fit, newdata = data.frame(time = 1:10)), time = 1:10, method = paste(method, id))
}
# Create a DF with the predictions, limited to current time range.
preds <- DF %>%
    group_by(combined) %>% 
    tidyr::nest() %>%
    mutate(pred = purrr::map(data, ~getPred(x = ., id = combined, method = 'lm'))) 
predDF <- do.call('rbind', preds$pred)    

One can plot the new lines by method:

p1 + geom_line(data = predDF, aes(x = time, y = y, group = method))

This gives you this:

However, the original plot does not have the colours (nor line types) mapped to the (new) levels of the method column (as they did not exist). Hence re-assigning colour for the predDF to 'method' does not work.

p1 + geom_line(data = predDF, aes(x = time, y = y, colour = method))

Error: Insufficient values in manual scale. 8 needed but only 4 provided.

Hence: is there any way to strip the mapping from a ggplot2 object and re-do it in a later stage? Or is there no other option than to re-build the entire graph (after binding the DF with predDF)?

Answer 1

You're reinventing the wheel a hit here. You don't need to create a prediction data frame. Instead, use method = lm inside a geom_smooth call. For colors and line types, you can borrow the aesthetic mapping from the first layer of p1:

p1 + geom_smooth(mapping = p1$layers[[1]]$mapping, formula = y~ x, method = lm,
                 se = FALSE)

Answer 2

Next to the answer from Allan, I also want to provide this simple solution I found the other day:

p1 +  scale_colour_manual('', values = rep(c('red', 'red', 'blue', 'blue'),2),
                          breaks = c(unique(DF$combined), unique(predDF$method))) +
  scale_linetype_manual('', values = rep(c(1,2,1,2),2),
                        breaks = c(unique(DF$combined), unique(predDF$method))) +
  geom_line(data = predDF, aes(x = time, y = y, colour = method, linetype = method))

It is only a matter of doing the re-mapping first, then adding new lines...