'How to draw a multi-colored dashed line (alternating colors for visual effect)

I was wondering if it is possible to create a multicolored dashed line in ggplot. Basically I have a plot displaying savings based on two packages.

A orange line with savings based on package A A green line with savings based on package B

I also have a third line and I would like that one to be dashed alterenating between orange and green. Is that something that somebody has been able to do?

Here is an example:

library(tidyverse)

S <- seq(0, 5, by = 0.05)

a <- S ^ 2
b <- S
a_b = a + b #This data should have the dashed multicolor line, since it is the sum of the other two lines.

S <- data.frame(S)
temp <- cbind(S, a, b, a_b)
temp <- gather(temp, variable, value, -S)
desiredOrder <- c("a", "b", "a_b")
temp$variable <- factor(temp$variable, levels = desiredOrder)
temp <- temp[order(temp$variable),]

p <- ggplot(temp, aes(x = S, y = value, colour = variable)) +
  theme_minimal() +
  geom_line(size = 1) +
  scale_color_manual(name = "Legend", values = c("orange", "green", "#0085bd"),
                     breaks = c("a", "b", "a_b"))
p

I basically want to have a multicolored (dashed or dotted) line for "c"

enter image description here



Solution 1:[1]

This is, to my best knowledge, currently only possible via creation of new segments for each alternate color. This is fiddly.

Below I've tried a largely programmatic approach in which you can define the size of the repeating segment (based on your x unit). The positioning of y values is slightly convoluted and it will also result in slightly irregular segment lengths when dealing with different slopes. I also haven't tested it on many data, either. But I guess it's a good start :)

For the legend, I'm taking the same approach, by creating a fake legend and stitching it onto the other plot. The challenges here include:

  1. positioning of legend elements relative to the plot
  2. relative distance between the legend elements

update For a much neater way to create those segments and a Stat implementation see this thread

library(tidyverse)
library(patchwork)

S <- seq(0, 5, by = 0.05)
a <- S^2
b <- S
a_b <- a + b

df <- data.frame(x = S, a, b, a_b) %>%
  pivot_longer(-x, names_to = "variable", values_to = "value")

## a function to create modifiable cuts in order to get segments.
## this looks convoluted - and it is! there are a few if/else statements.
## Why? The assigment of new y to x values depends on how many original values
## you have.
## There might be more direct ways to get there
alt_colors <- function(df, x, y, seg_length, my_cols) {
  x <- df[[x]]
  y <- df[[y]]
  ## create new x for each tiny segment
  length_seg <- seg_length / length(my_cols)
  new_x <- seq(min(x, na.rm = TRUE), x[length(x)], length_seg)
  ## now we need to interpolate y values for each new x
  ## This is different depending on how many x and new x you have
  if (length(new_x) < length(x)) {
    ind_int <- findInterval(new_x, x)
    new_y <- sapply(seq_along(ind_int), function(i) {
      if (y[ind_int[i]] == y[ind_int[length(ind_int)]]) {
        y[ind_int[i]]
      } else {
        seq_y <- seq(y[ind_int[i]], y[ind_int[i] + 1], length.out = length(my_cols))
        head(seq_y, -1)
      }
    })
  } else {
    ind_int <- findInterval(new_x, x)
    rle_int <- rle(ind_int)
    new_y <- sapply(rle_int$values, function(i) {
      if (y[i] == y[max(rle_int$values)]) {
        y[i]
      } else {
        seq_y <- seq(y[i], y[i + 1], length.out = rle_int$lengths[i] + 1)
        head(seq_y, -1)
      }
    })
  }
  ## THis is also a bit painful and might cause other bugs that I haven't
  ## discovered yet.
  if (length(unlist(new_y)) < length(new_x)) {
    newdat <- data.frame(
      x = new_x,
      y = rep_len(unlist(new_y), length.out = length(new_x))
    )
  } else {
    newdat <- data.frame(x = new_x, y = unlist(new_y))
  }
  newdat <- newdat %>%
    mutate(xend = lead(x), yend = lead(y)) %>%
    drop_na(xend)
  newdat$color <- my_cols
  newdat
}

## the below is just a demonstration of how the function would work
## using different segment widths
df_alt1 <-
  df %>%
  filter(variable == "a_b") %>%
  alt_colors("x", "value", 1, c("orange", "green"))

df_alt.5 <-
  df %>%
  filter(variable == "a_b") %>%
  alt_colors("x", "value", .5, c("orange", "green"))

df_ab <-
  df %>%
  filter(variable != "a_b") %>%
  # for the identity mapping
  mutate(color = ifelse(variable == "a", "green", "orange"))

## create data frame for the legend, also using the alt_colors function as per above
## the amount of x is a bit of trial and error, this is just a quick hack
## this is a trick to center the legend more or less relative to the main plot
y_leg <- ceiling(mean(range(df$value, na.rm = TRUE)))
dist_y <- 2

df_legend <-
  data.frame(
    variable = rep(unique(df$variable), each = 2),
    x = 1:2,
    y = rep(seq(y_leg - dist_y, y_leg + dist_y, by = dist_y), each = 2)
  )

df_leg_onecol <-
  df_legend %>%
  filter(variable != "a_b") %>%
  mutate(color = ifelse(variable == "a", "green", "orange"))

df_leg_alt <-
  df_legend %>%
  filter(variable == "a_b") %>%
  alt_colors("x", "y", .5, c("orange", "green"))

## I am mapping the colors globally using identity mapping (see scale_identity).
p1 <-
  ggplot(mapping = aes(x, value, colour = color)) +
  theme_minimal() +
  geom_line(data = df_ab, size = 1) +
  geom_segment(data = df_alt1, aes(y = y, xend = xend, yend = yend), size = 1) +
  scale_color_identity() +
  ggtitle("alternating every 1 unit")

p.5 <-
  ggplot(mapping = aes(x, value, colour = color)) +
  theme_minimal() +
  geom_line(data = df_ab, size = 1) +
  geom_segment(data = df_alt.5, aes(y = y, xend = xend, yend = yend), size = 1) +
  scale_color_identity() +
  ggtitle("alternating every .5 unit")

p_leg <-
  ggplot(mapping = aes(x, y, colour = color)) +
  theme_void() +
  geom_line(data = df_leg_onecol, size = 1) +
  geom_segment(data = df_leg_alt, aes(xend = xend, yend = yend), size = 1) +
  scale_color_identity() +
  annotate(
    geom = "text", y = unique(df_legend$y), label = unique(df_legend$variable),
    x = max(df_legend$x + 1), hjust = 0
  )

## set y limits to the range of the main plot
## in order to make the labels visible you need to adjust the plot margin and
## turn clipping off
p1 + p.5 +
  (p_leg + coord_cartesian(ylim = range(df$value), clip = "off") +
    theme(plot.margin = margin(r = 20, unit = "pt"))) +
  plot_layout(widths = c(1, 1, .2))

Created on 2022-01-18 by the reprex package (v2.0.1)

Solution 2:[2]

(Copied this over from Alternating color of individual dashes in a geom_line) Here's a ggplot hack that is simple, but works for two colors only. It results in two lines being overlayed, one a solid line, the other a dashed line.

library(dplyr)
library(ggplot2)
library(reshape2)

# Create df
x_value <- 1:10
group1 <- c(0,1,2,3,4,5,6,7,8,9)
group2 <- c(0,2,4,6,8,10,12,14,16,18)
dat <- data.frame(x_value, group1, group2) %>%
  mutate(group2_2 = group2) %>% # Duplicate the column that you want to be alternating colors
  melt(id.vars = "x_value", variable.name = "group", value.name ="y_value") # Long format

# Put in your selected order
dat$group <- factor(dat$group, levels=c("group1", "group2", "group2_2"))

# Plot
ggplot(dat, aes(x=x_value, y=y_value)) +
  geom_line(aes(color=group, linetype=group), size=1) +
  scale_color_manual(values=c("black", "red", "black")) +
  scale_linetype_manual(values=c("solid", "solid", "dashed")) 

Unfortunately the legend still needs to be edited by hand. Here's the example plot.

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1
Solution 2 Sabrina Arif