A file to setup a nice ggplot theme using Okabe-Ito (discrete/categorical) and Spectral colours (continuous).

rlang_okabeito_theme.R

# Just download it and `source rlang_okabeito_theme.R` to get your plots looking FAB-U-LOUS.


ggplot2::theme_set(
  ggplot2::theme_bw() +
  ggplot2::theme(
    strip.background = element_rect(
      color="black", fill="white", linewidth=0, linetype="solid"
    ),
    rect = element_rect(
      colour = "black",
      linewidth = 1,
      linetype = "solid"
    )
  )
)

NA_COLOUR <- '#C7C7C7'
NA_COLOR <- NA_COLOUR

# Here i set my default discrete colours.
# Okabe ito is a great colour-blind safe scheme.
# The true version includes black, but I prefer to control black separately as it attracts so much attention.

OKABE <- c(
  "tan"="#E9CA86",
  "orange"='#E69F00',
  "lightblue"='#56B4E9',
  "darkred"='#6D2D00FF',
  "lightgreen"="#84DBC4",
  "green"='#009E73',
  "yellow"='#F0E042',
  "brown"='#714C02FF',
  "blue"='#0072B2',
  "red"='#D55E00',
  "darkblue"='#003A5EFF',
  "lightpink"="#EECEE9",
  "pink"='#CC79A7'
)
PALETTE_DISCRETE <- OKABE

#colorblindr::cvd_grid(colorblindr::palette_plot(unname(OKABE)))

# This is a list of vectors of colours, in order of increasing length.
# The first vector that is long enough to include all of the colours is used for plotting.
# E.g. using 8 categories would use the okabe_9 set.
# I selected these to give me the best visual differentiation while still having enough colours for more complex plots.
# It's best to alternate between cool and warm colours to differentiate sets well. Which is why sometimes subsets are ordered slightly differently.
# short = These four are easy to distinguish and are the best looking in my opinion. We prioritise using them for cases with few categories.
# long  = Sometimes i need something with 10 colours. This adds three perceptually distinct dark variants of the red, yellow and darker blue.
# nine     = it's like long but without the poo brown.
PALETTE_DISCRETE_SUBSETS <- list(
  short = c('#E69F00', '#009E73', '#D55E00', '#0072B2', '#CC79A7'),
  standard = c('#E69F00', '#56B4E9', '#009E73', '#F0E042', '#0072B2', '#D55E00', '#CC79A7'),
  nine = c('#E69F00', '#56B4E9', '#6D2D00FF', '#009E73', '#F0E042', '#0072B2', '#D55E00', '#003A5EFF', '#CC79A7'),
  eleven = c('#E69F00', '#56B4E9', "#EECEE9", '#6D2D00FF', '#009E73', '#F0E042', '#714C02FF', '#0072B2', '#D55E00', '#003A5EFF', '#CC79A7'),
  long = c('#E69F00', '#56B4E9', "#E9CA86", '#6D2D00FF', "#EECEE9", '#009E73', '#F0E042', '#714C02FF', '#0072B2', '#D55E00', "#84DBC4", '#003A5EFF', '#CC79A7'),
  repeating = rep(unname(PALETTE_DISCRETE), 1000)
)

# ggplot will automatically go through the list and select the first one with enough colours for what it needs.
options(
  ggplot2.discrete.fill = PALETTE_DISCRETE_SUBSETS,
  ggplot2.discrete.colour = PALETTE_DISCRETE_SUBSETS,
  ggplot2.discrete.color = PALETTE_DISCRETE_SUBSETS,
  na.value = NA_COLOUR
)

palette_discrete <- function(n) {
  for (pal in PALETTE_DISCRETE_SUBSETS) {
    if (length(pal) >= n) {
      return(pal)
    }
  }
  stop("Sorry. We don't have a set big enough for your data!")
}

# Here i set the default continuous colour scales.
# I'm using the spectral scheme from colorbrewer, because it doesn't clash too much with okabe and i can use one half of it for a non-diverging scheme.
# RdYlBu is another good and simple scheme
#SPECTRAL <- RColorBrewer::brewer.pal(11, name = "Spectral")
SPECTRAL <- c("#9E0142", "#D53E4F", "#F46D43", "#FDAE61", "#FEE08B", "#FFFFBF", "#E6F598", "#ABDDA4", "#66C2A5", "#3288BD", "#5E4FA2")
PALETTE_DIVERGING <- SPECTRAL
PALETTE_CONTINUOUS <- rev(SPECTRAL[1:5])
PALETTE_CONTINUOUS_INVERSE <- SPECTRAL[7:length(SPECTRAL)]

#zero_centered <- function(x, ...) {
#  m <- quantile(abs(x), 0.95, na.rm = TRUE)
#  ceiling10 <- 10 ** ceiling(log10(m))
#  floor10 <- 10 ** floor(log10(m))
#
#  floor10m5 <- 10 ** (floor(log10(m * 2) - 1))
#  floor10m2 <- 10 ** (floor(log10(m * 5) - 1))
#  b2 <- 2 * floor10m2
#  b5 <- 5 * floor10m5
#
#  floor2 <- b2 ** floor(log(m, b2))
#  floor5 <- b5 ** floor(log(m, b5))
#
#  m2 <- b2 * ceiling(m / b2)
#  m5 <- b5 * ceiling(m / b5)
#  m10 <- floor10 * ceiling(m / floor10)
#
#  m <- min(c(m2, m5, m10), na.rm = TRUE)
#  x2 <- x / (2 * m)
#  x2 <- x2 + 0.5
#  return(x2)
#}

zero_centered <- function(lims) {
  m <- max(abs(lims), na.rm = TRUE)
  return(c(-m, m))
}

probability_centered <- function(lims) {
  stopifnot(all(lims >= 0 & lims <= 1))
  return(c(0 - 1e-4, 1 + 1e-4))
}

# These functions can be used directly with ggplot.
palette_fill_diverging <- function(...) {ggplot2::scale_fill_distiller(palette = "Spectral", na.value = NA_COLOUR, type = "div", ...)}
palette_colour_diverging <- function(...) {ggplot2::scale_color_distiller(palette = "Spectral", na.value = NA_COLOUR, aesthetics = "colour", type = "div", ...)}
palette_color_diverging <- palette_colour_diverging

palette_fill_diverging_zero <- function(...) {ggplot2::scale_fill_distiller(palette = "Spectral", limits = zero_centered, na.value = NA_COLOUR, type = "div", ...)}
palette_colour_diverging_zero <- function(...) {ggplot2::scale_color_distiller(palette = "Spectral", limits = zero_centered, na.value = NA_COLOUR, aesthetics = "colour", type = "div", ...)}
palette_color_diverging_zero <- palette_colour_diverging_zero

palette_fill_diverging_probability <- function(...) {ggplot2::scale_fill_distiller(palette = "Spectral", limits = probability_centered, na.value = NA_COLOUR, type = "div", ...)}
palette_colour_diverging_probability <- function(...) {ggplot2::scale_color_distiller(palette = "Spectral", limits = probability_centered, na.value = NA_COLOUR, aesthetics = "colour", type = "div", ...)}
palette_color_diverging_probability <- palette_colour_diverging_probability

palette_fill_continuous <- function(...) {scale_fill_gradientn(colours = PALETTE_CONTINUOUS, na.value = NA_COLOUR, ...)}
palette_colour_continuous <- function(...) {scale_colour_gradientn(colours = PALETTE_CONTINUOUS, na.value = NA_COLOUR, ...)}
palette_color_continuous <- palette_colour_continuous

# This sets the default ggplot continous palette.
# You'll need to specify the diverging palette as required.
options(ggplot2.continuous.fill = palette_fill_continuous, ggplot2.continuous.colour = palette_colour_continuous)


gen_cheatmap_robustscaler_cmap <- function(x, min = 0.001, max = 0.999, cmap = PALETTE_DIVERGING) {
  stopifnot((length(cmap) %% 2) == 1)
  min_ = quantile(x, min, na.rm = TRUE)
  max_ = quantile(x, max, na.rm = TRUE)
  breakpoints <- seq(min_, max_, length.out=length(cmap))
  return(circlize::colorRamp2(breakpoints, cmap))
}

gen_cheatmap_quantile_centered_cmap <- function(x, mid = 0.0, max = 0.999, cmap = PALETTE_DIVERGING) {
  stopifnot((length(cmap) %% 2) == 1)
  max_ = abs(quantile(x, max, na.rm = TRUE) - mid)
  min_ = abs(quantile(x, 1 - max, na.rm = TRUE) - mid)

  max_ <- max(c(max_, min_), na.rm = TRUE)
  min_ <- mid - max_
  max_ <- mid + max_
  breakpoints <- seq(min_, max_, length.out=length(cmap))
  return(circlize::colorRamp2(breakpoints, cmap))
}

gen_cheatmap_quantile_cmap <- function(x, cmap = PALETTE_DIVERGING) {
  stopifnot((length(cmap) %% 2) == 1)
  breakpoints <- quantile(x, seq(0, 1, length.out=length(cmap)), na.rm = TRUE)
  return(circlize::colorRamp2(breakpoints, cmap))
}

gen_cheatmap_minmax_cmap <- function(min, max, mid = NULL, cmap = PALETTE_DIVERGING) {
  stopifnot((length(cmap) %% 2) == 1)

  if (is.null(mid)) {
    breakpoints = seq(min, max, length.out = length(cmap))
  } else {
    lower <- seq(min, mid, length.out = ceiling(length(cmap) / 2))
    upper <- seq(mid, max, length.out = ceiling(length(cmap) / 2))
    breakpoints <- c(lower, upper[2:length(upper)])
  }

  return(circlize::colorRamp2(breakpoints, cmap))
}

gg_shape <- function(gg, vals) {gg + scale_shape_manual(values = rep(c(15, 17:20), 100))}


# Utility function from https://jokergoo.github.io/2020/05/11/set-cell-width/height-in-the-heatmap/
calc_ht_size = function(ht, unit = "inches") {
  pdf(NULL)
  ht = draw(ht)
  w = ComplexHeatmap:::width(ht)
  w = convertX(w, unit, valueOnly = TRUE)
  h = ComplexHeatmap:::height(ht)
  h = convertY(h, unit, valueOnly = TRUE)
  dev.off()

  c(w, h)
}


# Converts 0 to the smallest possible number before log calc
get_log <- function(vec){
  vec <- vec + .Machine$double.xmin
  vec <- -log10(vec)
}


reverselog_trans <- function(base = exp(1)) {
  trans <- function(x) -log(x, base)

  inv <- function(x) base^(-x)
  trans_new(paste0("reverselog-", format(base)), trans, inv,
            log_breaks(base = base),
            domain = c(1e-100, Inf))
}