Procházet zdrojové kódy

Add full_length_hex() because ggplot needs #123abc

tags/v0.3.0
Garrick Aden-Buie před 6 roky
rodič
revize
c544647c20
3 změnil soubory, kde provedl 74 přidání a 39 odebrání
  1. +15
    -0
      R/color.R
  2. +44
    -39
      R/ggplot2.R
  3. +15
    -0
      tests/testthat/test-color.R

+ 15
- 0
R/color.R Zobrazit soubor



whisker::iteratelist(colors, "color_name") whisker::iteratelist(colors, "color_name")
} }

full_length_hex <- function(x) {
if (!grepl("^#", x)) {
stop(paste0('"', x, '" is not a hexadecimal color'))
}
x <- sub("^#", "", x)
if (nchar(x) == 3) {
x <- strsplit(x, character(0))[[1]]
x <- rep(x, each = 2)
x <- paste(x, collapse = "")
} else if (nchar(x) != 6) {
stop(paste0('"', x, '" is not a hexadecimal color'))
}
paste0("#", x)
}

+ 44
- 39
R/ggplot2.R Zobrazit soubor

title_font_use_google = NULL, title_font_use_google = NULL,
title_font_size = NULL title_font_size = NULL
) { ) {
text_color <- full_length_hex(text_color)
background_color <- full_length_hex(background_color)

blend <- color_blender(text_color, background_color) blend <- color_blender(text_color, background_color)


text_font_size <- text_font_size %||% web_to_point(xaringanthemer_env$text_font_size, scale = 1.25) %||% 11 text_font_size <- text_font_size %||% web_to_point(xaringanthemer_env$text_font_size, scale = 1.25) %||% 11
if (set_ggplot_defaults) { if (set_ggplot_defaults) {
accent_color <- accent_color %||% xaringanthemer_env$header_color %||% text_color accent_color <- accent_color %||% xaringanthemer_env$header_color %||% text_color
accent_secondary_color <- accent_secondary_color %||% xaringanthemer_env$text_bold_color %||% accent_color accent_secondary_color <- accent_secondary_color %||% xaringanthemer_env$text_bold_color %||% accent_color
accent_color <- full_length_hex(accent_color)
accent_secondary_color <- full_length_hex(accent_secondary_color)
theme_xaringan_set_defaults(text_color, background_color, accent_color, accent_secondary_color) theme_xaringan_set_defaults(text_color, background_color, accent_color, accent_secondary_color)
} }


blend <- color_blender(text_color, background_color) blend <- color_blender(text_color, background_color)


xaringan_theme_defaults <- list( xaringan_theme_defaults <- list(
"line" = list(color = text_color),
"vline" = list(color = accent_secondary_color),
"hline" = list(color = accent_secondary_color),
"abline" = list(color = accent_secondary_color),
"segment" = list(color = text_color),
"bar" = list(fill = accent_color),
"col" = list(fill = accent_color),
"boxplot" = list(color = text_color),
"contour" = list(color = text_color),
"density" = list(color = text_color,
fill = text_color,
alpha = 0.1),
"dotplot" = list(color = accent_color),
"errorbarh" = list(color = text_color),
"crossbar" = list(color = text_color),
"errorbar" = list(color = text_color),
"linerange" = list(color = text_color),
"pointrange" = list(color = text_color),
"map" = list(color = text_color),
"path" = list(color = text_color),
"line" = list(color = text_color),
"step" = list(color = text_color),
"point" = list(color = accent_color),
"polygon" = list(color = accent_color,
fill = accent_color),
"quantile" = list(color = text_color),
"rug" = list(color = blend(0.5)),
"segment" = list(color = text_color),
"smooth" = list(fill = blend(0.75),
color = accent_secondary_color),
"spoke" = list(color = text_color),
"label" = list(color = text_color,
family = text_font %||% get_theme_font("text")),
"text" = list(color = text_color,
family = text_font %||% get_theme_font("text")),
"rect" = list(fill = text_color),
"tile" = list(fill = text_color),
"violin" = list(fill = text_color),
"sf" = list(color = text_color)
"line" = list(color = text_color),
"vline" = list(color = accent_secondary_color),
"hline" = list(color = accent_secondary_color),
"abline" = list(color = accent_secondary_color),
"segment" = list(color = text_color),
"bar" = list(fill = accent_color),
"col" = list(fill = accent_color),
"boxplot" = list(color = text_color),
"contour" = list(color = text_color),
"density" = list(color = text_color,
fill = text_color,
alpha = 0.1),
"dotplot" = list(color = accent_color),
"errorbarh" = list(color = text_color),
"crossbar" = list(color = text_color),
"errorbar" = list(color = text_color),
"linerange" = list(color = text_color),
"pointrange" = list(color = text_color),
"map" = list(color = text_color),
"path" = list(color = text_color),
"line" = list(color = text_color),
"step" = list(color = text_color),
"point" = list(color = accent_color),
"polygon" = list(color = accent_color,
fill = accent_color),
"quantile" = list(color = text_color),
"rug" = list(color = blend(0.5)),
"segment" = list(color = text_color),
"smooth" = list(fill = blend(0.75),
color = accent_secondary_color),
"spoke" = list(color = text_color),
"label" = list(color = text_color,
family= text_font %||% get_theme_font("text")),
"text" = list(color = text_color,
family= text_font %||% get_theme_font("text")),
"rect" = list(fill = text_color),
"tile" = list(fill = text_color),
"violin" = list(fill = text_color),
"sf" = list(color = text_color)
) )


geom_names <- purrr::set_names(names(xaringan_theme_defaults)) geom_names <- purrr::set_names(names(xaringan_theme_defaults))

+ 15
- 0
tests/testthat/test-color.R Zobrazit soubor

expect_equal(prepared[[1]]$value, colors[[1]]) expect_equal(prepared[[1]]$value, colors[[1]])
}) })
}) })


describe("full_length_hex()", {
it("makes 3-length hex to 6-length", {
expect_equal(full_length_hex("#123"), "#112233")
})

it("keeps length 6 hex", {
expect_equal(full_length_hex("#123456"), "#123456")
})

it("errors if not a hex color", {
expect_error(full_length_hex("123abc"))
})
})

Načítá se…
Zrušit
Uložit