Merge branch 'gen-dev' into 15-add-waffle-plots

DESCRIPTION

@@ -28,7 +28,8 @@ Imports:
     ggrepel,
     tidyr,
     dplyr,
-    ggalluvial
+    ggalluvial,
+    viridisLite
 Remotes: 
     github::hrbrmstr/waffle
 Suggests: knitr, sf, tmap

R/pal_agora.R

@@ -13,15 +13,9 @@ pal_agora <- function(palette = "main", reverse = FALSE, color_ramp_palette = FA
 
 
   palettes_agora <- list(
-    `main`            = cols_agora("main_grey", "main_red", "main_lt_grey", "main_beige"),
+    `main`            = cols_agora("main_bordeaux", "main_dk_beige", "main_lt_grey", "main_lt_beige"),
-    `primary`         = cols_agora("main_grey", "main_red"),
+    `primary`         = cols_agora("main_bordeaux", "main_dk_beige"),
-    `secondary`       = cols_agora("main_lt_grey", "main_beige"),
+    `secondary`       = cols_agora( "main_lt_grey", "main_lt_beige")
-    `two_dots`        = cols_agora("two_dots_1", "two_dots_2"),
-    `two_dots_flashy` = cols_agora("two_dots_flashy_1", "two_dots_flashy_2"),
-    `red_main`        = cols_agora("red_main_1", "red_main_2", "red_main_3", "red_main_4", "red_main_5"),
-    `red_alt`         = cols_agora("red_alt_1", "red_alt_2", "red_alt_3", "red_alt_4", "red_alt_5"),
-    `iroise`          = cols_agora("iroise_1", "iroise_2", "iroise_3", "iroise_4", "iroise_5"),
-    `discrete_6`      = cols_agora("dk_grey", "red_main_1", "main_beige", "red_main_2", "lt_grey_2", "red_4")
   )
 
   if (show_palettes) return(names(palettes_agora))

R/pal_fallback.R

@@ -0,0 +1,19 @@
+pal_fallback <- function(reverse = FALSE,
+                         color_ramp_palette = FALSE,
+                         discrete = FALSE,
+                         n = 5,
+                         ...){
+
+  pal <- if(discrete) { viridisLite::viridis(n) } else {viridisLite::magma(n)}
+
+  if (reverse) pal <- rev(pal)
+
+  if (color_ramp_palette) {
+    rlang::check_installed("grDevices", reason = "Package \"grDevices\" needed for `pal_fallback()` with 'color_ramp_palette' set to `TRUE` to work. Please install it.")
+
+    pal <- grDevices::colorRampPalette(pal, ...)
+  }
+
+  return(pal)
+
+}

R/scale.R

@@ -1,6 +1,6 @@
 #' Color scale constructor for REACH or AGORA colors
 #'
-#' @param initiative Either "reach" or "agora.
+#' @param initiative Either "reach" or "agora" or "default".
 #' @param palette Palette name from `pal_reach()` or `pal_agora()`.
 #' @param discrete Boolean indicating whether color aesthetic is discrete or not.
 #' @param reverse Boolean indicating whether the palette should be reversed.
@@ -11,24 +11,85 @@
 #' @return A color scale for ggplot
 #'
 #' @export
-scale_color  <- function(initiative = "reach", palette = "main", discrete = TRUE, reverse = FALSE, reverse_guide = TRUE, ...) {
+scale_color <- function(initiative = "reach", palette = "main", discrete = TRUE, reverse = FALSE, reverse_guide = TRUE, ...) {
 
   if (initiative == "reach") {
-    pal <- pal_reach(
+
-      palette = palette,
+    pal <- pal_reach(palette)
-      reverse = reverse,
+
-      color_ramp_palette = TRUE,
+    if (is.null(pal)) {
-      show_palettes = FALSE
+
+      pal <- pal_fallback(
+        reverse = reverse,
+        discrete = discrete,
+        color_ramp_palette = TRUE)
+
+      rlang::warn(
+        c(
+          paste0("There is no palette '", palette, "' for the selected initiative. Fallback to pal_fallback()."),
+          "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of available palettes.")
+        )
       )
+
+      if (discrete) palette <- "viridis" else palette <- "magma"
+
+    } else {
+
+      pal <- pal_reach(
+        palette = palette,
+        reverse = reverse,
+        color_ramp_palette = TRUE,
+        show_palettes = FALSE
+      )
+
+    }
+
   } else if (initiative == "agora") {
-    pal <- pal_agora(
+
-      palette = palette,
+    pal <- pal_agora(palette)
+
+    if (is.null(pal)) {
+
+      pal <- pal_fallback(
+        reverse = reverse,
+        discrete = discrete,
+        color_ramp_palette = TRUE)
+
+      rlang::warn(
+        c(
+          paste0("There is no palette '", palette, "' for the selected initiative. Fallback to pal_fallback()."),
+          "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of available palettes.")
+        )
+      )
+
+      if (discrete) palette <- "viridis" else palette <- "magma"
+
+    } else {
+
+      pal <- pal_agora(
+        palette = palette,
+        reverse = reverse,
+        color_ramp_palette = TRUE,
+        show_palettes = FALSE
+      )
+    }
+
+  } else if (initiative == "default") {
+
+    pal <- pal_fallback(
       reverse = reverse,
-      color_ramp_palette = TRUE,
+      discrete = discrete,
-      show_palettes = FALSE
+      color_ramp_palette = TRUE)
-    )
+
+    if (discrete) palette <- "viridis" else palette <- "magma"
+
   } else {
-    rlang::abort(c("Wrong initiative parameter input", "*" = paste0(initiative, "is not an option"), "i" = "Parameter 'initiative' should be one of 'reach' or 'agora'"))
+    rlang::abort(
+      c(
+        paste0("There is no initiative '", initiative, "."),
+        "i" = paste0("initiative should be either 'reach', 'agora' or 'default'")
+      )
+    )
   }
 
   if (discrete) {
@@ -41,8 +102,10 @@ scale_color  <- function(initiative = "reach", palette = "main", discrete = TRUE
         draw.ulim = TRUE,
         draw.llim = TRUE,
         ticks.colour = "#F1F3F5",
-        reverse = reverse_guide),
+        reverse = reverse_guide
-      ...)
+      ),
+      ...
+    )
   } else {
     ggplot2::scale_color_gradientn(
       colours = pal(256),
@@ -53,7 +116,8 @@ scale_color  <- function(initiative = "reach", palette = "main", discrete = TRUE
         ticks.colour = "#F1F3F5",
         reverse = reverse_guide
       ),
-      ...)
+      ...
+    )
   }
 }
 
@@ -61,7 +125,7 @@ scale_color  <- function(initiative = "reach", palette = "main", discrete = TRUE
 
 #' Fill scale constructor for REACH or AGORA colors
 #'
-#' @param initiative Either "reach" or "agora.
+#' @param initiative Either "reach" or "agora" or "default".
 #' @param palette Palette name from `pal_reach()` or `pal_agora()`.
 #' @param discrete Boolean indicating whether color aesthetic is discrete or not.
 #' @param reverse Boolean indicating whether the palette should be reversed.
@@ -72,29 +136,90 @@ scale_color  <- function(initiative = "reach", palette = "main", discrete = TRUE
 #' @return A fill scale for ggplot.
 #'
 #' @export
-scale_fill  <- function(initiative = "reach", palette = "main", discrete = TRUE, reverse = FALSE, reverse_guide = TRUE, ...) {
+scale_fill <- function(initiative = "reach", palette = "main", discrete = TRUE, reverse = FALSE, reverse_guide = TRUE, ...) {
 
   if (initiative == "reach") {
-    pal <- pal_reach(
+
-      palette = palette,
+    pal <- pal_reach(palette)
-      reverse = reverse,
+
-      color_ramp_palette = TRUE,
+    if (is.null(pal)) {
-      show_palettes = FALSE
+
-    )
+      pal <- pal_fallback(
+        reverse = reverse,
+        discrete = discrete,
+        color_ramp_palette = TRUE)
+
+      rlang::warn(
+        c(
+          paste0("There is no palette '", palette, "' for the selected initiative. Fallback to pal_fallback()."),
+          "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of available palettes.")
+        )
+      )
+
+      if (discrete) palette <- "viridis" else palette <- "magma"
+
+    } else {
+
+      pal <- pal_reach(
+        palette = palette,
+        reverse = reverse,
+        color_ramp_palette = TRUE,
+        show_palettes = FALSE
+      )
+
+    }
+
   } else if (initiative == "agora") {
-    pal <- pal_agora(
+
-      palette = palette,
+    pal <- pal_agora(palette)
+
+    if (is.null(pal)) {
+
+      pal <- pal_fallback(
+        reverse = reverse,
+        discrete = discrete,
+        color_ramp_palette = TRUE)
+
+      rlang::warn(
+        c(
+          paste0("There is no palette '", palette, "' for the selected initiative. Fallback to pal_fallback()."),
+          "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of available palettes.")
+        )
+      )
+
+      if (discrete) palette <- "viridis" else palette <- "magma"
+
+    } else {
+
+      pal <- pal_agora(
+        palette = palette,
+        reverse = reverse,
+        color_ramp_palette = TRUE,
+        show_palettes = FALSE
+      )
+    }
+
+  } else if (initiative == "default") {
+
+    pal <- pal_fallback(
       reverse = reverse,
-      color_ramp_palette = TRUE,
+      discrete = discrete,
-      show_palettes = FALSE
+      color_ramp_palette = TRUE)
-    )
+
+    if (discrete) palette <- "viridis" else palette <- "magma"
+
   } else {
-    rlang::abort(c("Wrong initiative parameter input", "*" = paste0(initiative, "is not an option"), "i" = "Parameter 'initiative' should be one of 'reach' or 'agora'"))
+    rlang::abort(
+      c(
+        paste0("There is no initiative '", initiative, "."),
+        "i" = paste0("initiative should be either 'reach', 'agora' or 'default'")
+      )
+    )
   }
 
   if (discrete) {
     ggplot2::discrete_scale(
-      "fill",
+      "colour",
       paste0(initiative, "_", palette),
       palette = pal,
       guide = ggplot2::guide_legend(
@@ -102,17 +227,21 @@ scale_fill  <- function(initiative = "reach", palette = "main", discrete = TRUE,
         draw.ulim = TRUE,
         draw.llim = TRUE,
         ticks.colour = "#F1F3F5",
-        reverse = reverse_guide),
+        reverse = reverse_guide
-      ...)
+      ),
+      ...
+    )
   } else {
-    ggplot2::scale_fill_gradientn(
+    ggplot2::scale_color_gradientn(
       colours = pal(256),
       guide = ggplot2::guide_colorbar(
         title.position = "top",
         draw.ulim = TRUE,
         draw.llim = TRUE,
         ticks.colour = "#F1F3F5",
-        reverse = reverse_guide),
+        reverse = reverse_guide
-        ...)
+      ),
+      ...
+    )
   }
 }

R/theme_reach.R

@@ -1,5 +1,6 @@
 #' @title ggplot2 theme with REACH color palettes
 #'
+#' @param initiative Either "reach" or "default".
 #' @param palette Palette name from 'pal_reach()'.
 #' @param discrete 	Boolean indicating whether color aesthetic is discrete or not.
 #' @param reverse Boolean indicating whether the palette should be reversed.
@@ -56,10 +57,11 @@
 #'
 #' @export
 theme_reach <- function(
+    initiative = "reach",
     palette = "main",
     discrete = TRUE,
     reverse = FALSE,
-    font_family = "Segoe UI",
+    font_family = "segoeui",
     title_size = 12,
     title_color = cols_reach("main_grey"),
     title_font_face = "bold",
@@ -108,6 +110,14 @@ theme_reach <- function(
   # To do :
   # - add facet theming
 
+  if (!initiative %in% c("reach", "default"))
+    rlang::abort(
+      c(
+        paste0("There is no initiative '", initiative, " to be used with theme_reach()."),
+        "i" = paste0("initiative should be either 'reach' or 'default'")
+      )
+    )
+
   # Basic simple theme
   # theme_reach <- ggplot2::theme_bw()
 
@@ -264,28 +274,12 @@ theme_reach <- function(
   # Other parameters
   theme_reach <- theme_reach + ggplot2::theme(...)
 
-
-  # Check if palette is an actual existing palette
-  pal <- pal_reach(palette)
-
-  if(is.null(pal)) {
-    rlang::warn(
-      c(
-        paste0("There is no palette '", palette, "' for initiative 'reach'. Fallback to REACH main palette."),
-        "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of availabale palettes.")
-        )
-      )
-
-    palette <- "main"
-
-  }
-
   # Add reach color palettes by default
   # (reversed guide is defaulted to TRUE for natural reading)
   theme_reach <- list(
     theme_reach,
-    scale_color(palette = palette, discrete = discrete, reverse = reverse, reverse_guide = legend_reverse),
+    scale_color(initiative = initiative, palette = palette, discrete = discrete, reverse = reverse, reverse_guide = legend_reverse),
-    scale_fill(palette = palette, discrete = discrete, reverse = reverse, reverse_guide = legend_reverse)
+    scale_fill(initiative = initiative, palette = palette, discrete = discrete, reverse = reverse, reverse_guide = legend_reverse)
     )