nestcolor coverage - 91.78%

Files
Source

#' Color Palettes Used in NEST
#'
#' @description `r lifecycle::badge("stable")`
#'
#' A standardized color palette to be used for all plots within
#' the NEST project.
#'
#' @param n (\code{numeric} value) \cr
#'   The number of colors to be returned from
#'   the color palettes. Please note the colors will be repeated after
#'   a certain numerical limit per palette:
#'
#'   \itemize{
#'      \item `nest` 96 colors
#'      \item `stream` 38 colors
#'      \item `viridis` 49 colors
#'      \item `accessible` 18 colors
#'   }
#'
#' @param palette (\code{character} value)\cr
#'   The name of a palette supported by this function
#'
#'   \itemize{
#'      \item `nest` A color palette developed by the NEST team representing colors in the NEST logo.
#'      \item `stream` A color palette proposed by the stream documentation of stream version \code{2_05}
#'      \item `viridis` A color palette provided by the \code{viridis::plasma} function.
#'      \item `accessible` A color palette consisting of accessible colors for those with color blindness.
#'   }
#' @return A list of hex color code
#'
#' @examples
#' library(grid)
#'
#' plot_pal <- function(x) {
#'   grid.newpage()
#'   pushViewport(plotViewport(rep(1, 4)))
#'   pushViewport(viewport(layout = grid.layout(1, ncol = length(x))))
#'   for (i in seq_along(x)) {
#'     grid.rect(
#'       gp = gpar(fill = x[i], col = NA),
#'       vp = viewport(layout.pos.col = i, layout.pos.row = 1)
#'     )
#'   }
#' }
#'
#' plot_pal(color_palette(n = 10, palette = "nest"))
#'
#' plot_pal(color_palette(n = 10, palette = "stream"))
#'
#' plot_pal(color_palette(n = 10, palette = "viridis"))
#'
#' plot_pal(color_palette(n = 10, palette = "accessible"))
#'
#' @export
color_palette <- function(n = 10, palette = "nest") {
  # Validate inputs
  checkmate::assert_string(palette)
  checkmate::assert_number(n)

  # Define colors
  palettes <- list(
    "nest" = c(
      "#ff2951ff", "#2995ffff", "#81832Bff", "#AC1CF8", "#1CF853", "#F8761C", "#F8341C",
      "#F81CC5", "#2D1CF8", "#1CF8DC", "#6EF81C", "#F8B81C", "#F81C25", "#F81C85", "#EC1CF8",
      "#6D1CF8", "#1C4BF8", "#1CD0F8", "#1CF898", "#2AF81C", "#B3F81C", "#F8D91C", "#F8971C",
      "#F8551C", "#F8241C", "#F81C35", "#F81C65", "#F81CA5", "#F81CE5", "#CC1CF8", "#8D1CF8",
      "#4D1CF8", "#1C2BF8", "#1C6BF8", "#1CAEF8", "#1CF2F8", "#1CF8BA", "#1CF876", "#1CF831",
      "#4CF81C", "#91F81C", "#D5F81C", "#F8E91C", "#F8C91C", "#F8A81C", "#F8871C", "#F8661C",
      "#F8451C", "#F81C1D", "#F81C2D", "#F81C3D", "#F81C55", "#F81C75", "#F81C95", "#F81CB5",
      "#F81CD5", "#F81CF5", "#DC1CF8", "#BC1CF8", "#9D1CF8", "#7D1CF8", "#5D1CF8", "#3D1CF8",
      "#1D1CF8", "#1C3BF8", "#1C5BF8", "#1C7BF8", "#1C9DF8", "#1CBFF8", "#1CE1F8", "#1CF8ED",
      "#1CF8CB", "#1CF8A9", "#1CF887", "#1CF865", "#1CF842", "#1CF820", "#3BF81C", "#5DF81C",
      "#80F81C", "#A2F81C", "#C4F81C", "#E6F81C", "#F8F11C", "#F8E11C", "#F8D11C", "#F8C11C",
      "#F8B01C", "#F8A01C", "#F88F1C", "#F87F1C", "#F86E1C", "#F85E1C", "#F84D1C", "#F83D1C",
      "#F82C1C"
    ),
    "stream" = c(
      "#343cff", "#ff484b", "#232323", "#329032", "#ffa41c", "#750375", "#1d831c", "#767676",
      "#9b2525", "#008080", "#ff1f8e", "#bdb771", "#ffd92d", "#000bff", "#ff0004", "#090909",
      "#379336", "#ffa722", "#750375", "#2f9999", "#ff2c95", "#bfb976", "#ffdd41", "#3438ff",
      "#ff0004", "#000000", "#047503", "#ff9a05", "#7a0d7a", "#a94343", "#008080", "#ffa825",
      "#ff1388", "#bdb771", "#ffe258", "#141dff", "#ff0004", "#000000"
    ),
    "viridis" = c(
      "#0D0887", "#FB9E3B", "#FDC927", "#D8576C", "#47039F", "#BE3686", "#47039F",
      "#7301A8", "#ED7953", "#9C179E", "#F0F921", "#BE3686", "#47039F", "#BE3686",
      "#ED7953", "#0D0887", "#47039F", "#9C179E", "#D8576C", "#F0F921", "#D8576C",
      "#FB9E3B", "#F0F921", "#FDC927", "#0D0887", "#7301A8", "#FB9E3B", "#9C179E",
      "#FDC927", "#7301A8", "#F0F921", "#ED7953", "#BE3686", "#F0F921", "#D8576C",
      "#9C179E", "#D8576C", "#9C179E", "#0D0887", "#47039F", "#FDC927", "#FDC927",
      "#FB9E3B", "#FB9E3B", "#7301A8", "#BE3686", "#ED7953", "#ED7953", "#7301A8"
    ),

    # Inclusive/accessible color palettes
    "accessible" = c(
      "#E8F086", "#6FDE6E", "#FF4242", "#A691AE", "#235FA4", "#0A284B",
      "#BDD9BF", "#929084", "#FFC857", "#A997DF", "#E5323B", "#2E4052",
      "#E1DAAE", "#FF934F", "#CC2D35", "#058ED9", "#848FA2", "#2D3142"
    )
  )

  # Validate input
  match.arg(palette, names(palettes))

  # Get colors for specified palette/color scheme
  color_scheme <- unlist(
    palettes[palette],
    use.names = FALSE
  )

  # Return vector of colors
  colors <- rep(
    color_scheme,
    ceiling(
      n / length(color_scheme)
    )
  )
  return(colors[seq_len(n)])
}

#' Returns a custom `NEST` `ggplot2` theme
#'
#' @param font_size (`numeric`) font size to be passed to `[ggplot2::element_text()]`
#' @param ... (`list`) additional arguments to `[ggplot2::theme()]`
#' @return Return ggplot theme
#' @export
#' @examples
#' plot <- ggplot2::ggplot(iris, ggplot2::aes(x = Sepal.Length, y = Sepal.Width)) +
#'   ggplot2::geom_point() +
#'   theme_nest()
theme_nest <- function(font_size = 10, ...) {
  checkmate::assert_number(font_size, finite = TRUE)
  ggplot2::theme(
    panel.grid.major = ggplot2::element_blank(),
    panel.grid.minor = ggplot2::element_blank(),
    panel.background = ggplot2::element_blank(),
    panel.border = ggplot2::element_rect(colour = "grey", fill = NA, linewidth = 1),
    legend.position = "bottom",
    legend.background = ggplot2::element_blank(),
    legend.box.background = ggplot2::element_rect(colour = "grey", fill = NA, linewidth = 1),
    legend.direction = "horizontal",
    legend.title = ggplot2::element_text(face = "bold"),
    text = ggplot2::element_text(size = font_size),
    plot.caption = ggplot2::element_text(hjust = 0),
    ...
  )
}

1		.onLoad <- function(libname, pkgname) { # nolint
2	!	pal <- color_palette(n = 20, palette = "stream")
3	!	options(
4	!	ggplot2.discrete.colour = pal,
5	!	ggplot2.discrete.fill = pal
6		)
7	!	invisible()
8		}

1		#' Color Palettes Used in NEST
2		#'
3		#' @description `r lifecycle::badge("stable")`
4		#'
5		#' A standardized color palette to be used for all plots within
6		#' the NEST project.
7		#'
8		#' @param n (\code{numeric} value) \cr
9		#' The number of colors to be returned from
10		#' the color palettes. Please note the colors will be repeated after
11		#' a certain numerical limit per palette:
12		#'
13		#' \itemize{
14		#' \item `nest` 96 colors
15		#' \item `stream` 38 colors
16		#' \item `viridis` 49 colors
17		#' \item `accessible` 18 colors
18		#' }
19		#'
20		#' @param palette (\code{character} value)\cr
21		#' The name of a palette supported by this function
22		#'
23		#' \itemize{
24		#' \item `nest` A color palette developed by the NEST team representing colors in the NEST logo.
25		#' \item `stream` A color palette proposed by the stream documentation of stream version \code{2_05}
26		#' \item `viridis` A color palette provided by the \code{viridis::plasma} function.
27		#' \item `accessible` A color palette consisting of accessible colors for those with color blindness.
28		#' }
29		#' @return A list of hex color code
30		#'
31		#' @examples
32		#' library(grid)
33		#'
34		#' plot_pal <- function(x) {
35		#' grid.newpage()
36		#' pushViewport(plotViewport(rep(1, 4)))
37		#' pushViewport(viewport(layout = grid.layout(1, ncol = length(x))))
38		#' for (i in seq_along(x)) {
39		#' grid.rect(
40		#' gp = gpar(fill = x[i], col = NA),
41		#' vp = viewport(layout.pos.col = i, layout.pos.row = 1)
42		#' )
43		#' }
44		#' }
45		#'
46		#' plot_pal(color_palette(n = 10, palette = "nest"))
47		#'
48		#' plot_pal(color_palette(n = 10, palette = "stream"))
49		#'
50		#' plot_pal(color_palette(n = 10, palette = "viridis"))
51		#'
52		#' plot_pal(color_palette(n = 10, palette = "accessible"))
53		#'
54		#' @export
55		color_palette <- function(n = 10, palette = "nest") {
56		# Validate inputs
57	5x	checkmate::assert_string(palette)
58	5x	checkmate::assert_number(n)
59
60		# Define colors
61	5x	palettes <- list(
62	5x	"nest" = c(
63	5x	"#ff2951ff", "#2995ffff", "#81832Bff", "#AC1CF8", "#1CF853", "#F8761C", "#F8341C",
64	5x	"#F81CC5", "#2D1CF8", "#1CF8DC", "#6EF81C", "#F8B81C", "#F81C25", "#F81C85", "#EC1CF8",
65	5x	"#6D1CF8", "#1C4BF8", "#1CD0F8", "#1CF898", "#2AF81C", "#B3F81C", "#F8D91C", "#F8971C",
66	5x	"#F8551C", "#F8241C", "#F81C35", "#F81C65", "#F81CA5", "#F81CE5", "#CC1CF8", "#8D1CF8",
67	5x	"#4D1CF8", "#1C2BF8", "#1C6BF8", "#1CAEF8", "#1CF2F8", "#1CF8BA", "#1CF876", "#1CF831",
68	5x	"#4CF81C", "#91F81C", "#D5F81C", "#F8E91C", "#F8C91C", "#F8A81C", "#F8871C", "#F8661C",
69	5x	"#F8451C", "#F81C1D", "#F81C2D", "#F81C3D", "#F81C55", "#F81C75", "#F81C95", "#F81CB5",
70	5x	"#F81CD5", "#F81CF5", "#DC1CF8", "#BC1CF8", "#9D1CF8", "#7D1CF8", "#5D1CF8", "#3D1CF8",
71	5x	"#1D1CF8", "#1C3BF8", "#1C5BF8", "#1C7BF8", "#1C9DF8", "#1CBFF8", "#1CE1F8", "#1CF8ED",
72	5x	"#1CF8CB", "#1CF8A9", "#1CF887", "#1CF865", "#1CF842", "#1CF820", "#3BF81C", "#5DF81C",
73	5x	"#80F81C", "#A2F81C", "#C4F81C", "#E6F81C", "#F8F11C", "#F8E11C", "#F8D11C", "#F8C11C",
74	5x	"#F8B01C", "#F8A01C", "#F88F1C", "#F87F1C", "#F86E1C", "#F85E1C", "#F84D1C", "#F83D1C",
75	5x	"#F82C1C"
76		),
77	5x	"stream" = c(
78	5x	"#343cff", "#ff484b", "#232323", "#329032", "#ffa41c", "#750375", "#1d831c", "#767676",
79	5x	"#9b2525", "#008080", "#ff1f8e", "#bdb771", "#ffd92d", "#000bff", "#ff0004", "#090909",
80	5x	"#379336", "#ffa722", "#750375", "#2f9999", "#ff2c95", "#bfb976", "#ffdd41", "#3438ff",
81	5x	"#ff0004", "#000000", "#047503", "#ff9a05", "#7a0d7a", "#a94343", "#008080", "#ffa825",
82	5x	"#ff1388", "#bdb771", "#ffe258", "#141dff", "#ff0004", "#000000"
83		),
84	5x	"viridis" = c(
85	5x	"#0D0887", "#FB9E3B", "#FDC927", "#D8576C", "#47039F", "#BE3686", "#47039F",
86	5x	"#7301A8", "#ED7953", "#9C179E", "#F0F921", "#BE3686", "#47039F", "#BE3686",
87	5x	"#ED7953", "#0D0887", "#47039F", "#9C179E", "#D8576C", "#F0F921", "#D8576C",
88	5x	"#FB9E3B", "#F0F921", "#FDC927", "#0D0887", "#7301A8", "#FB9E3B", "#9C179E",
89	5x	"#FDC927", "#7301A8", "#F0F921", "#ED7953", "#BE3686", "#F0F921", "#D8576C",
90	5x	"#9C179E", "#D8576C", "#9C179E", "#0D0887", "#47039F", "#FDC927", "#FDC927",
91	5x	"#FB9E3B", "#FB9E3B", "#7301A8", "#BE3686", "#ED7953", "#ED7953", "#7301A8"
92		),
93
94		# Inclusive/accessible color palettes
95	5x	"accessible" = c(
96	5x	"#E8F086", "#6FDE6E", "#FF4242", "#A691AE", "#235FA4", "#0A284B",
97	5x	"#BDD9BF", "#929084", "#FFC857", "#A997DF", "#E5323B", "#2E4052",
98	5x	"#E1DAAE", "#FF934F", "#CC2D35", "#058ED9", "#848FA2", "#2D3142"
99		)
100		)
101
102		# Validate input
103	5x	match.arg(palette, names(palettes))
104
105		# Get colors for specified palette/color scheme
106	5x	color_scheme <- unlist(
107	5x	palettes[palette],
108	5x	use.names = FALSE
109		)
110
111		# Return vector of colors
112	5x	colors <- rep(
113	5x	color_scheme,
114	5x	ceiling(
115	5x	n / length(color_scheme)
116		)
117		)
118	5x	return(colors[seq_len(n)])
119		}

1		#' Returns a custom `NEST` `ggplot2` theme
2		#'
3		#' @param font_size (`numeric`) font size to be passed to `[ggplot2::element_text()]`
4		#' @param ... (`list`) additional arguments to `[ggplot2::theme()]`
5		#' @return Return ggplot theme
6		#' @export
7		#' @examples
8		#' plot <- ggplot2::ggplot(iris, ggplot2::aes(x = Sepal.Length, y = Sepal.Width)) +
9		#' ggplot2::geom_point() +
10		#' theme_nest()
11		theme_nest <- function(font_size = 10, ...) {
12	4x	checkmate::assert_number(font_size, finite = TRUE)
13	2x	ggplot2::theme(
14	2x	panel.grid.major = ggplot2::element_blank(),
15	2x	panel.grid.minor = ggplot2::element_blank(),
16	2x	panel.background = ggplot2::element_blank(),
17	2x	panel.border = ggplot2::element_rect(colour = "grey", fill = NA, linewidth = 1),
18	2x	legend.position = "bottom",
19	2x	legend.background = ggplot2::element_blank(),
20	2x	legend.box.background = ggplot2::element_rect(colour = "grey", fill = NA, linewidth = 1),
21	2x	legend.direction = "horizontal",
22	2x	legend.title = ggplot2::element_text(face = "bold"),
23	2x	text = ggplot2::element_text(size = font_size),
24	2x	plot.caption = ggplot2::element_text(hjust = 0),
25		...
26		)
27		}