ggplot linking scales

all.R

library(ggplot2)
t1<-seq(0,40,0.2)

a1<-seq(from =1, to =0, length.out = length(t1))
a2<-seq(from = 1, to = 0.4, length.out = length(t1))
a3<-seq(from = 1, to = 0.6, length.out = length(t1))
df1<-data.frame(time = t1, surv = a1)
df2<-data.frame(time = t1, surv = a2)
df3<-data.frame(time = t1, surv = a3)

library(dplyr)
all_df <- bind_rows(
    df1 %>% mutate(linetype = "dotdash", color ="#F8766D", label = "g1"),
    df2 %>% mutate(linetype = "dashed", color = "#00BFC4", label = "g2"),
    df3 %>% mutate(linetype = "solid", color = "#00BA38", label = "g3")
) 
all_df <- bind_rows(
    df1 %>% mutate(linetype = "dotdash", color ="red", label = "g1"),
    df2 %>% mutate(linetype = "dashed", color = "green", label = "g2"),
    df3 %>% mutate(linetype = "solid", color = "blue", label = "g3")
) %>% mutate(linetype = factor(linetype, levels = unique(.$linetype), labels = unique(.$linetype)),
             color = factor(color, levels = unique(.$color), labels = unique(.$color)))

link_factors <- function(df, ...) {
    cgroups <- PKPDmisc::capture_groups(df)
    label_levels <- df %>% ungroup %>%
        dplyr::distinct(...)
    dot_list <- lapply(names(label_levels), function(nm) {
        lazyeval::interp(
            ~ factor(nm, levels = label_levels$nm, labels = label_levels$nm),
            nm = as.name(nm)
        )
    })
    df %>% dplyr::ungroup() %>% 
        dplyr::mutate_(.dots = setNames(dot_list, names(label_levels))) %>%
        group_by_(.dots = cgroups)
}

link_scales <- function(pl, df, .name, .labelcol,  ...) {
    label_levels <- df %>% ungroup %>%
        dplyr::distinct(...)
    .names <- names(label_levels)[-which(names(label_levels) == .labelcol)]
    dot_list <- lapply(.names, function(nm) {
        scale <- paste0(c("scale", nm, "identity"), collapse = "_")
        lazyeval::interp(
            ~ scale(name = .name, 
                    labels = label_levels$.label, 
                    breaks = label_levels$.nm, 
                    guide = "legend"),
            scale = as.name(scale),
            .nm = as.name(nm),
            .label = as.name(.label)
        )
    })
    Reduce(function(x, s) {
        x + lazyeval::lazy_eval(s)
    }, dot_list,  pl)
}


all_df <- bind_rows(
    df1 %>% mutate(linetype = "dotdash", color ="#F8766D", label = "g1"),
    df2 %>% mutate(linetype = "dashed", color = "#00BFC4", label = "g2"),
    df3 %>% mutate(linetype = "solid", color = "#00BA38", label = "g3")
)  %>%
    # link factors will factorize and make sure the order/relationships are maintained across multiple
    # columns worth of factors
    link_factors(linetype, color)

df_labels <- distinct(all_df, linetype, color, label)

pl <- all_df %>%
    ggplot(aes(x = time, y = surv)) +
    geom_line(aes(linetype = linetype, color = color), size = 1.5) 

pl %>%
    # link scales will provide identity scales for any of the specified aesthetics 
    # for example, here it is set for scale_linetype_identity and scale_color_identity
    # with the name of group and the associated labels from the label column
    link_scales(df_labels, "group", "label", linetype, color, label)


 pl + scale_linetype_identity(name = "group", 
                              labels = df_labels$label, 
                              breaks = df_labels$linetype, 
                              guide = "legend") +
     scale_color_identity(name = "group", 
                          labels = df_labels$label, 
                          = df_labels$color, 
                          guide = "legend") +
    theme_bw()