Merge pull request #44 from nanxstats/observable

Implement Observable 10 palette

NAMESPACE

@@ -16,6 +16,7 @@ export(pal_locuszoom)
 export(pal_material)
 export(pal_nejm)
 export(pal_npg)
+export(pal_observable)
 export(pal_rickandmorty)
 export(pal_simpsons)
 export(pal_startrek)
@@ -40,6 +41,7 @@ export(scale_color_locuszoom)
 export(scale_color_material)
 export(scale_color_nejm)
 export(scale_color_npg)
+export(scale_color_observable)
 export(scale_color_rickandmorty)
 export(scale_color_simpsons)
 export(scale_color_startrek)
@@ -62,6 +64,7 @@ export(scale_colour_locuszoom)
 export(scale_colour_material)
 export(scale_colour_nejm)
 export(scale_colour_npg)
+export(scale_colour_observable)
 export(scale_colour_rickandmorty)
 export(scale_colour_simpsons)
 export(scale_colour_startrek)
@@ -84,6 +87,7 @@ export(scale_fill_locuszoom)
 export(scale_fill_material)
 export(scale_fill_nejm)
 export(scale_fill_npg)
+export(scale_fill_observable)
 export(scale_fill_rickandmorty)
 export(scale_fill_simpsons)
 export(scale_fill_startrek)

NEWS.md

@@ -1,5 +1,10 @@
 # ggsci 3.1.0.9000
 
+## New features
+
+- Add the Observable 10 palette in `scale_color_observable()`
+  and `scale_fill_observable()` (#41).
+
 ## Improvements
 
 - Move internal color palette data from `R/sysdata.rda` to `R/palettes.R`.

R/discrete-observable.R

@@ -0,0 +1,104 @@
+#' Observable 10 color palette
+#'
+#' The Observable 10 palette.
+#'
+#' @param palette Palette type.
+#'   Currently there is one available option: `"observable10"`
+#'   (10-color palette).
+#' @param alpha Transparency level, a real number in (0, 1].
+#'   See `alpha` in [grDevices::rgb()] for details.
+#'
+#' @export pal_observable
+#'
+#' @importFrom grDevices col2rgb rgb
+#' @importFrom scales manual_pal
+#'
+#' @author Nan Xiao | \email{me@nanx.me} | <https://nanx.me>
+#'
+#' @references
+#' Pettiross J (2023). "Crafting data colors and staying on brand."
+#' _Observable blog_. <https://observablehq.com/blog/crafting-data-colors>
+#'
+#' @examples
+#' library("scales")
+#' show_col(pal_observable("observable10")(10))
+#' show_col(pal_observable("observable10", alpha = 0.6)(10))
+pal_observable <- function(palette = c("observable10"), alpha = 1) {
+  palette <- match.arg(palette)
+
+  if (alpha > 1L || alpha <= 0L) stop("alpha must be in (0, 1]")
+
+  raw_cols <- ggsci_db$"observable"[[palette]]
+  raw_cols_rgb <- col2rgb(raw_cols)
+  alpha_cols <- rgb(
+    raw_cols_rgb[1L, ], raw_cols_rgb[2L, ], raw_cols_rgb[3L, ],
+    alpha = alpha * 255L, names = names(raw_cols),
+    maxColorValue = 255L
+  )
+
+  manual_pal(unname(alpha_cols))
+}
+
+#' Observable 10 color scales
+#'
+#' See [pal_observable()] for details.
+#'
+#' @inheritParams pal_observable
+#' @param ... Additional parameters for [ggplot2::discrete_scale()].
+#'
+#' @export scale_color_observable
+#'
+#' @importFrom ggplot2 discrete_scale
+#'
+#' @author Nan Xiao | \email{me@nanx.me} | <https://nanx.me>
+#'
+#' @references
+#' Pettiross J (2023). "Crafting data colors and staying on brand."
+#' _Observable blog_. <https://observablehq.com/blog/crafting-data-colors>
+#'
+#' @rdname scale_observable
+#'
+#' @examples
+#' library("ggplot2")
+#' data("diamonds")
+#'
+#' ggplot(
+#'   subset(diamonds, carat >= 2.2),
+#'   aes(x = table, y = price, colour = cut)
+#' ) +
+#'   geom_point(alpha = 0.7) +
+#'   geom_smooth(method = "loess", alpha = 0.1, size = 1, span = 1) +
+#'   theme_bw() +
+#'   scale_color_observable()
+#'
+#' ggplot(
+#'   subset(diamonds, carat > 2.2 & depth > 55 & depth < 70),
+#'   aes(x = depth, fill = cut)
+#' ) +
+#'   geom_histogram(colour = "black", binwidth = 1, position = "dodge") +
+#'   theme_bw() +
+#'   scale_fill_observable()
+scale_color_observable <- function(palette = c("observable10"), alpha = 1, ...) {
+  palette <- match.arg(palette)
+  if (is_ggplot2_350()) {
+    discrete_scale("colour", palette = pal_observable(palette, alpha), ...)
+  } else {
+    discrete_scale("colour", scale_name = "observable", palette = pal_observable(palette, alpha), ...)
+  }
+}
+
+#' @export scale_colour_observable
+#' @rdname scale_observable
+scale_colour_observable <- scale_color_observable
+
+#' @export scale_fill_observable
+#' @importFrom ggplot2 discrete_scale
+#' @rdname scale_observable
+scale_fill_observable <- function(palette = c("observable10"), alpha = 1, ...) {
+  palette <- match.arg(palette)
+  if (is_ggplot2_350()) {
+    discrete_scale("fill", palette = pal_observable(palette, alpha), ...)
+  } else {
+    discrete_scale("fill", scale_name = "observable", palette = pal_observable(palette, alpha), ...)
+  }
+}

R/palettes.R

@@ -137,6 +137,20 @@ ggsci_db$"d3"$"category20c" <- c(
   "Snuff" = "#DADAEB", "Alto" = "#D9D9D9"
 )
 
+# Observable 10 color palette
+ggsci_db$"observable"$"observable10" <- c(
+  "Blue" = "#4269D0",
+  "Orange" = "#EFB118",
+  "Red" = "#FF725C",
+  "Cyan" = "#6CC5B0",
+  "Green" = "#3CA951",
+  "Pink" = "#FF8AB7",
+  "Purple" = "#A463F2",
+  "LightBlue" = "#97BBF5",
+  "Brown" = "#9C6B4E",
+  "Gray" = "#9498A0"
+)
+
 # Color palette inspired by IGV
 ggsci_db$"igv"$"default" <- c(
   "chr1" = "#5050FF", "chr2" = "#CE3D32", "chr3" = "#749B58",

README.Rmd

@@ -158,6 +158,14 @@ p2_d3 <- p2 + scale_fill_d3()
 grid.arrange(p1_d3, p2_d3, ncol = 2)
 ```
 
+### Observable
+
+```{r, ggsci-observable}
+p1_observable <- p1 + scale_color_observable()
+p2_observable <- p2 + scale_fill_observable()
+grid.arrange(p1_observable, p2_observable, ncol = 2)
+```
+
 ### LocusZoom
 
 ```{r, ggsci-locuszoom}

README.md

@@ -71,6 +71,10 @@ open with `vignette("ggsci")` in R) for a quick-start guide.
 
 <img src="man/figures/README-ggsci-d3-1.png" width="100%" style="display: block; margin: auto;" />
 
+### Observable
+
+<img src="man/figures/README-ggsci-observable-1.png" width="100%" style="display: block; margin: auto;" />
+
 ### LocusZoom
 
 <img src="man/figures/README-ggsci-locuszoom-1.png" width="100%" style="display: block; margin: auto;" />

_pkgdown.yml

@@ -60,6 +60,12 @@ reference:
       - scale_color_d3
       - scale_colour_d3
       - scale_fill_d3
+  - title: "Observable"
+    contents:
+      - pal_observable
+      - scale_color_observable
+      - scale_colour_observable
+      - scale_fill_observable
   - title: "LocusZoom"
     contents:
       - pal_locuszoom

vignettes/ggsci.Rmd

@@ -84,6 +84,9 @@ summarized in the table below.
 |                 |                              | `"category20b"`                |                      |
 |                 |                              | `"category20c"`                |                      |
 +-----------------+------------------------------+--------------------------------+----------------------+
+| Observable      | `scale_color_observable()`   | `"observable10"`               | `pal_observable()`   |
+|                 | `scale_fill_observable()`    |                                |                      |
++-----------------+------------------------------+--------------------------------+----------------------+
 | LocusZoom       | `scale_color_locuszoom()`    | `"default"`                    | `pal_locuszoom()`    |
 |                 | `scale_fill_locuszoom()`     |                                |                      |
 +-----------------+------------------------------+--------------------------------+----------------------+
@@ -266,6 +269,17 @@ p2_d3 <- p2 + scale_fill_d3()
 grid.arrange(p1_d3, p2_d3, ncol = 2)
 ```
 
+### Observable
+
+The [Observable 10 palette](https://observablehq.com/blog/crafting-data-colors)
+is the default categorical colors scheme used by Observable.
+
+```{r}
+p1_observable <- p1 + scale_color_observable()
+p2_observable <- p2 + scale_fill_observable()
+grid.arrange(p1_observable, p2_observable, ncol = 2)
+```
+
 ### LocusZoom
 
 The LocusZoom palette is based on the colors used by