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

Time:05-13

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

initial plot

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:

second plot but no colour mapping

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)?

CodePudding user response:

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)

enter image description here

CodePudding user response:

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...

  • Related