😎 Give your xaringan slides some style
選択できるのは25トピックまでです。 トピックは、先頭が英数字で、英数字とダッシュ('-')を使用した35文字以内のものにしてください。

978 行
30KB

  1. #' A Plot Theme for ggplot2 by xaringanthemer
  2. #'
  3. #' @description
  4. #'
  5. #' **Lifecycle:** [Maturing](https://www.tidyverse.org/lifecycle/#maturing)
  6. #'
  7. #' Creates \pkg{ggplot2} themes to match the xaringanthemer theme used in the
  8. #' \pkg{xaringan} slides that seamlessly matches the "normal" slide colors and
  9. #' styles.
  10. #'
  11. #' @param text_color Color for text and foreground, inherits from `text_color`
  12. #' @param background_color Color for background, inherits from
  13. #' `background_color`
  14. #' @param accent_color Color for titles and accents, inherits from
  15. #' `header_color`
  16. #' @param accent_secondary_color Color for secondary accents, inherits from
  17. #' `text_bold_color`
  18. #' @param css_file Path to a \pkg{xaringanthemer} CSS file, from which the
  19. #' theme variables and values will be inferred. In general, if you use the
  20. #' \pkg{xaringathemer} defaults, you will not need to set this. This feature
  21. #' lets you create a \pkg{ggplot2} theme for your \pkg{xaringan} slides, even
  22. #' if you have only saved your theme CSS file and you aren't creating your
  23. #' CSS theme with \pkg{xaringanthemer} in your slides' source file.
  24. #' @inheritParams theme_xaringan_base
  25. #'
  26. #' @examples
  27. #' # Requires ggplot2
  28. #' has_ggplot2 <- requireNamespace("ggplot2", quietly = TRUE)
  29. #'
  30. #' if (has_ggplot2) {
  31. #' # Because this is an example, we'll save the CSS to a temp file
  32. #' path_to_css_file <- tempfile(fileext = ".css")
  33. #'
  34. #' # Create the xaringan theme: dark blue background with teal green accents
  35. #' style_duo(
  36. #' primary_color = "#002b36",
  37. #' secondary_color = "#31b09e",
  38. #' # Using basic fonts for this example, but the plot theme will
  39. #' # automatically use your theme font if you use Google fonts
  40. #' text_font_family = "sans",
  41. #' header_font_family = "serif",
  42. #' outfile = path_to_css_file
  43. #' )
  44. #'
  45. #' library(ggplot2)
  46. #' ggplot(iris) +
  47. #' aes(Petal.Length, Petal.Width) +
  48. #' geom_point() +
  49. #' ggtitle("Yet another Iris plot") +
  50. #' theme_xaringan()
  51. #' }
  52. #' @return A ggplot2 theme
  53. #' @family xaringanthemer ggplot2 themes
  54. #' @export
  55. theme_xaringan <- function(
  56. text_color = NULL,
  57. background_color = NULL,
  58. accent_color = NULL,
  59. accent_secondary_color = NULL,
  60. css_file = NULL,
  61. set_ggplot_defaults = TRUE,
  62. text_font = NULL,
  63. text_font_use_google = NULL,
  64. text_font_size = NULL,
  65. title_font = NULL,
  66. title_font_use_google = NULL,
  67. title_font_size = NULL,
  68. use_showtext = TRUE
  69. ) {
  70. requires_xaringanthemer_env(css_file = css_file, try_css = TRUE)
  71. requires_package(fn = "xaringan_theme")
  72. background_color <- background_color %||% xaringanthemer_env$background_color
  73. text_color <- text_color %||% xaringanthemer_env$text_color
  74. accent_color <- accent_color %||% xaringanthemer_env$header_color
  75. accent_secondary_color <- accent_secondary_color %||% xaringanthemer_env$text_bold_color %||% accent_color
  76. theme_xaringan_base(
  77. text_color,
  78. background_color,
  79. accent_color = accent_color,
  80. accent_secondary_color = accent_secondary_color,
  81. set_ggplot_defaults = set_ggplot_defaults,
  82. text_font = text_font,
  83. text_font_use_google = text_font_use_google,
  84. text_font_size = text_font_size,
  85. title_font = title_font,
  86. title_font_use_google = title_font_use_google,
  87. title_font_size = title_font_size,
  88. use_showtext = use_showtext
  89. )
  90. }
  91. #' An Inverse Plot Theme for ggplot2 by xaringanthemer
  92. #'
  93. #' @description
  94. #'
  95. #' **Lifecycle:** [Maturing](https://www.tidyverse.org/lifecycle/#maturing)
  96. #'
  97. #' A \pkg{ggplot2} xaringanthemer plot theme to seamlessly match the "inverse"
  98. #' \pkg{xaringan} slide colors and styles as styled by [xaringanthemer].
  99. #'
  100. #' @param text_color Color for text and foreground, inherits from `text_color`
  101. #' @param background_color Color for background, inherits from
  102. #' `background_color`
  103. #' @param accent_color Color for titles and accents, inherits from
  104. #' `header_color`
  105. #' @param accent_secondary_color Color for secondary accents, inherits from
  106. #' `text_bold_color`
  107. #' @inheritParams theme_xaringan
  108. #' @inheritParams theme_xaringan_base
  109. #'
  110. #' @examples
  111. #' # Requires ggplot2
  112. #' has_ggplot2 <- requireNamespace("ggplot2", quietly = TRUE)
  113. #'
  114. #' if (has_ggplot2) {
  115. #' # Because this is an example, we'll save the CSS to a temp file
  116. #' path_to_css_file <- tempfile(fileext = ".css")
  117. #'
  118. #' # Create the xaringan theme: dark blue background with teal green accents
  119. #' style_duo(
  120. #' primary_color = "#002b36",
  121. #' secondary_color = "#31b09e",
  122. #' # Using basic fonts for this example, but the plot theme will
  123. #' # automatically use your theme font if you use Google fonts
  124. #' text_font_family = "sans",
  125. #' header_font_family = "serif",
  126. #' outfile = path_to_css_file
  127. #' )
  128. #'
  129. #' library(ggplot2)
  130. #' ggplot(iris) +
  131. #' aes(Petal.Length, Petal.Width) +
  132. #' geom_point() +
  133. #' ggtitle("Yet another Iris plot") +
  134. #' # themed to match the inverse slides: teal background with dark blue text
  135. #' theme_xaringan_inverse()
  136. #' }
  137. #' @return A ggplot2 theme
  138. #' @family xaringanthemer ggplot2 themes
  139. #' @export
  140. theme_xaringan_inverse <- function(
  141. text_color = NULL,
  142. background_color = NULL,
  143. accent_color = NULL,
  144. accent_secondary_color = NULL,
  145. css_file = NULL,
  146. set_ggplot_defaults = TRUE,
  147. text_font = NULL,
  148. text_font_use_google = NULL,
  149. text_font_size = NULL,
  150. title_font = NULL,
  151. title_font_use_google = NULL,
  152. title_font_size = NULL,
  153. use_showtext = TRUE
  154. ) {
  155. requires_xaringanthemer_env(css_file = css_file, try_css = TRUE)
  156. requires_package(fn = "xaringan_theme")
  157. background_color <- background_color %||% xaringanthemer_env$inverse_background_color
  158. text_color <- text_color %||% xaringanthemer_env$inverse_text_color
  159. accent_color <- accent_color %||% xaringanthemer_env$inverse_header_color
  160. accent_secondary_color <- accent_secondary_color %||% accent_color
  161. theme_xaringan_base(
  162. text_color,
  163. background_color,
  164. accent_color = accent_color,
  165. accent_secondary_color = accent_secondary_color,
  166. set_ggplot_defaults = set_ggplot_defaults,
  167. text_font = text_font,
  168. text_font_use_google = text_font_use_google,
  169. text_font_size = text_font_size,
  170. title_font = title_font,
  171. title_font_use_google = title_font_use_google,
  172. title_font_size = title_font_size,
  173. use_showtext = use_showtext
  174. )
  175. }
  176. #' The ggplot2 xaringanthemer base plot theme
  177. #'
  178. #' @description
  179. #'
  180. #' **Lifecycle:** [Maturing](https://www.tidyverse.org/lifecycle/#maturing)
  181. #'
  182. #' Provides a base plot theme for \pkg{ggplot2} to match the \pkg{xaringan} slide theme
  183. #' created by [xaringanthemer]. The theme is designed to create a general plot
  184. #' style from two colors, a `background_color` and a `text_color` (or foreground
  185. #' color). Also accepts an `accent_color` and an `accent_secondary_color` that are
  186. #' [xaringanthemer] is not required for the base theme. Use
  187. #' [theme_xaringan()] or [theme_xaringan_inverse()] in xaringan slides styled by
  188. #' xaringanthemer for a plot theme that matches the slide style.
  189. #'
  190. #' @param text_color Color for text and foreground
  191. #' @param background_color Color for background
  192. #' @param accent_color Color for titles and accents, inherits from
  193. #' `header_color` or `text_color`. Used for the `title` base setting in
  194. #' [ggplot2::theme()], and additionally for setting the `color` or `fill` of
  195. #' \pkg{ggplot2} geom defaults.
  196. #' @param accent_secondary_color Color for secondary accents, inherits from
  197. #' `text_bold_color` or `accent_color`. Used only when setting \pkg{ggplot2} geom
  198. #' defaults.
  199. #' @param set_ggplot_defaults Should defaults be set for \pkg{ggplot2} _geoms_?
  200. #' Defaults to TRUE. To restore ggplot's defaults, or the previously set geom
  201. #' defaults, see [theme_xaringan_restore_defaults()].
  202. #' @param text_font Font to use for text elements, passed to
  203. #' [sysfonts::font_add_google()], if available and `text_font_use_google` is
  204. #' `TRUE`. Inherits from `text_font_family`.
  205. #' @param text_font_use_google Is `text_font` available on [Google
  206. #' Fonts](https://fonts.google.com)?
  207. #' @param text_font_size Base text font size, inherits from `text_font_size`, or
  208. #' defaults to 11.
  209. #' @param title_font Font to use for title elements, passed to
  210. #' [sysfonts::font_add_google()], if available and `title_font_use_google` is
  211. #' `TRUE`. Inherits from `title_font_family`.
  212. #' @param title_font_use_google Is `title_font` available on [Google
  213. #' Fonts](https://fonts.google.com)?
  214. #' @param title_font_size Base text font size, inherits from `title_font_size`,
  215. #' or defaults to 14.
  216. #' @param use_showtext If `TRUE` (default) the \pkg{showtext} package will be
  217. #' used to register Google fonts. Set to `FALSE` to disable this feature
  218. #' entirely, which may result in errors during plotting if the fonts used are
  219. #' not available locally.
  220. #' @param ... Ignored
  221. #'
  222. #' @examples
  223. #' # Requires ggplot2
  224. #' has_ggplot2 <- requireNamespace("ggplot2", quietly = TRUE)
  225. #'
  226. #' if (has_ggplot2) {
  227. #' library(ggplot2)
  228. #'
  229. #' plot1 <- ggplot(iris) +
  230. #' aes(Petal.Length, Petal.Width) +
  231. #' geom_point() +
  232. #' theme_xaringan_base(
  233. #' text_color = "#602f6b", # imperial
  234. #' background_color = "#f8f8f8", # light gray
  235. #' accent_color = "#317873", # myrtle green
  236. #' title_font = "sans",
  237. #' text_font = "serif",
  238. #' set_ggplot_defaults = TRUE
  239. #' ) +
  240. #' labs(
  241. #' title = "Basic Iris Plot",
  242. #' subtitle = "+ theme_xaringan_base()",
  243. #' caption = "xaringanthemer"
  244. #' )
  245. #'
  246. #' print(plot1)
  247. #'
  248. #' plot2 <- ggplot(iris) +
  249. #' aes(Sepal.Width) +
  250. #' geom_histogram(binwidth = 0.1) +
  251. #' theme_xaringan_base(
  252. #' text_color = "#a8a9c8", # light purple
  253. #' background_color = "#303163", # deep slate purple
  254. #' accent_color = "#ffff99", # canary yellow
  255. #' title_font = "sans",
  256. #' text_font = "serif",
  257. #' set_ggplot_defaults = TRUE
  258. #' ) +
  259. #' labs(
  260. #' title = "Basic Iris Plot",
  261. #' subtitle = "+ theme_xaringan_base()",
  262. #' caption = "xaringanthemer"
  263. #' )
  264. #'
  265. #' print(plot2)
  266. #' }
  267. #' @return A ggplot2 theme
  268. #' @family xaringanthemer ggplot2 themes
  269. #' @export
  270. theme_xaringan_base <- function(
  271. text_color,
  272. background_color,
  273. ...,
  274. set_ggplot_defaults = TRUE,
  275. accent_color = NULL,
  276. accent_secondary_color = NULL,
  277. text_font = NULL,
  278. text_font_use_google = NULL,
  279. text_font_size = NULL,
  280. title_font = NULL,
  281. title_font_use_google = NULL,
  282. title_font_size = NULL,
  283. use_showtext = TRUE
  284. ) {
  285. text_color <- full_length_hex(text_color)
  286. background_color <- full_length_hex(background_color)
  287. blend <- color_blender(text_color, background_color)
  288. text_font_size <- text_font_size %||% web_to_point(xaringanthemer_env$text_font_size, scale = 1.25) %||% 11
  289. title_font_size <- title_font_size %||% web_to_point(xaringanthemer_env$header_h3_font_size, scale = 0.8) %||% 14
  290. text_font <- if (!is.null(text_font)) {
  291. register_font(text_font, identical(text_font_use_google, TRUE) && use_showtext)
  292. } else {
  293. get_theme_font("text")
  294. }
  295. title_font <- if (!is.null(title_font)) {
  296. register_font(title_font, identical(title_font_use_google, TRUE) && use_showtext)
  297. } else {
  298. get_theme_font("header")
  299. }
  300. text_font %||% "sans"
  301. title_font %||% "sans"
  302. if (set_ggplot_defaults) {
  303. accent_color <- accent_color %||% xaringanthemer_env$header_color %||% text_color
  304. accent_secondary_color <- accent_secondary_color %||% xaringanthemer_env$text_bold_color %||% accent_color
  305. accent_color <- full_length_hex(accent_color)
  306. accent_secondary_color <- full_length_hex(accent_secondary_color)
  307. theme_xaringan_set_defaults(text_color, background_color, accent_color, accent_secondary_color)
  308. }
  309. ggplot2::theme(
  310. line = ggplot2::element_line(color = blend(0.2)),
  311. rect = ggplot2::element_rect(fill = background_color),
  312. text = ggplot2::element_text(
  313. color = blend(0.1),
  314. family = text_font,
  315. size = text_font_size
  316. ),
  317. title = ggplot2::element_text(
  318. color = accent_color,
  319. family = title_font,
  320. size = title_font_size
  321. ),
  322. plot.background = ggplot2::element_rect(
  323. fill = background_color,
  324. color = background_color
  325. ),
  326. panel.background = ggplot2::element_rect(
  327. fill = background_color,
  328. color = background_color
  329. ),
  330. panel.grid.major = ggplot2::element_line(
  331. color = blend(0.8),
  332. inherit.blank = TRUE
  333. ),
  334. panel.grid.minor = ggplot2::element_line(
  335. color = blend(0.9),
  336. inherit.blank = TRUE
  337. ),
  338. axis.title = ggplot2::element_text(size = title_font_size * 0.8),
  339. axis.ticks = ggplot2::element_line(color = blend(0.8)),
  340. axis.text = ggplot2::element_text(color = blend(0.4)),
  341. legend.key = ggplot2::element_rect(fill = "transparent", colour = NA),
  342. plot.caption = ggplot2::element_text(
  343. size = text_font_size * 0.8,
  344. color = blend(0.3)
  345. )
  346. )
  347. }
  348. #' Set and Restore ggplot2 geom Defaults
  349. #'
  350. #' @description
  351. #'
  352. #' **Lifecycle:** [Maturing](https://www.tidyverse.org/lifecycle/#maturing)
  353. #'
  354. #' Set \pkg{ggplot2} _geom_ defaults to match [theme_xaringan()] with
  355. #' `theme_xaringan_set_defaults()` and restore the standard or previously-set
  356. #' defaults with `theme_xaringan_restore_defaults()`. By default,
  357. #' `theme_xaringan_set_defaults()` is run with [theme_xaringan()] or
  358. #' [theme_xaringan_inverse()].
  359. #'
  360. #' @family xaringanthemer ggplot2 themes
  361. #' @inheritParams theme_xaringan
  362. #' @inheritParams theme_xaringan_base
  363. #' @return Invisibly returns a list of the current ggplot2 geom defaults
  364. #' @export
  365. theme_xaringan_set_defaults <- function(
  366. text_color = NULL,
  367. background_color = NULL,
  368. accent_color = text_color,
  369. accent_secondary_color = accent_color,
  370. text_font = NULL
  371. ) {
  372. requires_package("ggplot2")
  373. blend <- color_blender(text_color, background_color)
  374. xaringan_theme_defaults <- list(
  375. "line" = list(color = text_color),
  376. "vline" = list(color = accent_secondary_color),
  377. "hline" = list(color = accent_secondary_color),
  378. "abline" = list(color = accent_secondary_color),
  379. "segment" = list(color = text_color),
  380. "bar" = list(fill = accent_color),
  381. "col" = list(fill = accent_color),
  382. "boxplot" = list(color = text_color),
  383. "contour" = list(color = text_color),
  384. "density" = list(color = text_color,
  385. fill = text_color,
  386. alpha = 0.1),
  387. "dotplot" = list(color = accent_color),
  388. "errorbarh" = list(color = text_color),
  389. "crossbar" = list(color = text_color),
  390. "errorbar" = list(color = text_color),
  391. "linerange" = list(color = text_color),
  392. "pointrange" = list(color = text_color),
  393. "map" = list(color = text_color),
  394. "path" = list(color = text_color),
  395. "line" = list(color = text_color),
  396. "step" = list(color = text_color),
  397. "point" = list(color = accent_color),
  398. "polygon" = list(color = accent_color,
  399. fill = accent_color),
  400. "quantile" = list(color = text_color),
  401. "rug" = list(color = blend(0.5)),
  402. "segment" = list(color = text_color),
  403. "smooth" = list(fill = blend(0.75),
  404. color = accent_secondary_color),
  405. "spoke" = list(color = text_color),
  406. "label" = list(color = text_color,
  407. family= text_font %||% get_theme_font("text")),
  408. "text" = list(color = text_color,
  409. family= text_font %||% get_theme_font("text")),
  410. "rect" = list(fill = text_color),
  411. "tile" = list(fill = text_color),
  412. "violin" = list(fill = text_color),
  413. "sf" = list(color = text_color)
  414. )
  415. geom_names <- purrr::set_names(names(xaringan_theme_defaults))
  416. previous_defaults <- lapply(
  417. geom_names,
  418. function(geom) safely_set_geom(geom, xaringan_theme_defaults[[geom]])
  419. )
  420. if (is.null(xaringanthemer_env$old_ggplot_defaults)) {
  421. xaringanthemer_env$old_ggplot_defaults <- previous_defaults
  422. }
  423. invisible(previous_defaults)
  424. }
  425. #' @describeIn theme_xaringan_set_defaults Restore previous or standard
  426. #' \pkg{ggplot2} _geom_ defaults.
  427. #' @return Invisibly returns a list of the current ggplot2 geom defaults
  428. #' @export
  429. theme_xaringan_restore_defaults <- function() {
  430. requires_package("ggplot2")
  431. requires_xaringanthemer_env(try_css = FALSE, requires_theme = FALSE)
  432. if (is.null(xaringanthemer_env$old_ggplot_defaults)) {
  433. return(invisible())
  434. }
  435. old_default <- xaringanthemer_env$old_ggplot_defaults
  436. old_default_not_std <- vapply(old_default, function(x) length(x) > 0, logical(1))
  437. old_default <- old_default[old_default_not_std]
  438. restore_default <- utils::modifyList(xaringanthemer_env$std_ggplot_defaults, old_default)
  439. geom_names <- purrr::set_names(names(restore_default))
  440. previous_defaults <- lapply(
  441. geom_names,
  442. function(geom) safely_set_geom(geom, restore_default[[geom]])
  443. )
  444. invisible(previous_defaults)
  445. }
  446. safely_set_geom <- function(geom, new) {
  447. tryCatch(
  448. {
  449. ggplot2::update_geom_defaults(geom, new)
  450. },
  451. error = function(e) invisible(),
  452. warning = function(w) invisible()
  453. )
  454. }
  455. # Color Scales ------------------------------------------------------------
  456. #' Xaringan Themer ggplot2 Scales
  457. #'
  458. #' @description
  459. #'
  460. #' **Lifecycle:** [Maturing](https://www.tidyverse.org/lifecycle/#maturing)
  461. #'
  462. #' Color and fill single-color scales for discrete and continuous values,
  463. #' created using the primary accent color of the xaringanthemer styles.
  464. #'
  465. #' @param ... Arguments passed on to either the \pkg{colorspace} scale
  466. #' functions — one of [colorspace::scale_color_discrete_sequential],
  467. #' [colorspace::scale_color_continuous_sequential],
  468. #' [colorspace::scale_fill_discrete_sequential], or
  469. #' [colorspace::scale_fill_continuous_sequential] — or to
  470. #' [ggplot2::continuous_scale] or [ggplot2::discrete_scale].
  471. #' @param color A color value, in hex, to override the default color. Otherwise,
  472. #' the primary color of the resulting scale is chosen from the xaringanthemer
  473. #' slide styles.
  474. #' @param inverse If `color` is not supplied and `inverse = TRUE`, a primary
  475. #' color is chosen to work well with the inverse slide styles, namely the
  476. #' value of `inverse_header_color`
  477. #' @param direction Direction of the discrete scale. Use values less than 0 to
  478. #' reverse the direction, e.g. `direction = -1`.
  479. #' @inheritParams colorspace::scale_color_continuous_sequential
  480. #' @param aes_type The type of aesthetic to which the scale is being applied.
  481. #' One of "color", "colour", or "fill".
  482. #'
  483. #'
  484. #' @examples
  485. #' # Requires ggplot2
  486. #' has_ggplot2 <- requireNamespace("ggplot2", quietly = TRUE)
  487. #'
  488. #' if (has_ggplot2) {
  489. #' library(ggplot2)
  490. #' ex <- data.frame(
  491. #' name = c("Couple", "Few", "Lots", "Many"),
  492. #' n = c(2, 3, 5, 7)
  493. #' )
  494. #' ggplot(ex) +
  495. #' aes(name, n, fill = n) +
  496. #' geom_col() +
  497. #' ggtitle("Matching fill scales") +
  498. #' # themed to match the slides: dark blue background with teal text
  499. #' theme_xaringan() +
  500. #' # Fill color matches teal text
  501. #' scale_xaringan_fill_continuous()
  502. #'
  503. #' ggplot(ex) +
  504. #' aes(name, y = 1, color = name) +
  505. #' geom_point(size = 10) +
  506. #' ggtitle("Matching color scales") +
  507. #' # themed to match the slides: dark blue background with teal text
  508. #' theme_xaringan() +
  509. #' # Fill color matches teal text
  510. #' scale_xaringan_color_discrete(direction = -1)
  511. #' }
  512. #'
  513. #' @name scale_xaringan
  514. NULL
  515. #' @rdname scale_xaringan
  516. #' @export
  517. scale_xaringan_discrete <- function(
  518. aes_type = c("color", "colour", "fill"),
  519. ...,
  520. color = NULL,
  521. direction = 1,
  522. inverse = FALSE
  523. ) {
  524. requires_package("ggplot2", "scale_xaringan_discrete")
  525. aes_type <- match.arg(aes_type)
  526. color <- hex2HCL(get_theme_accent_color(color, inverse))
  527. pal <- function(n) {
  528. colors <- colorspace::sequential_hcl(
  529. n = n,
  530. c1 = color[1, "C"],
  531. l1 = color[1, "L"],
  532. h1 = color[1, "H"],
  533. rev = direction >= 1
  534. )
  535. }
  536. ggplot2::discrete_scale(aes_type, "manual", pal, ...)
  537. }
  538. #' @rdname scale_xaringan
  539. #' @export
  540. scale_xaringan_fill_discrete <- function(
  541. ...,
  542. color = NULL,
  543. direction = 1,
  544. inverse = FALSE
  545. ) {
  546. scale_xaringan_discrete(
  547. "fill",
  548. ...,
  549. color = color,
  550. direction = direction,
  551. inverse = inverse
  552. )
  553. }
  554. #' @rdname scale_xaringan
  555. #' @export
  556. scale_xaringan_color_discrete <- function(
  557. ...,
  558. color = NULL,
  559. direction = 1,
  560. inverse = FALSE
  561. ) {
  562. scale_xaringan_discrete(
  563. "color",
  564. ...,
  565. color = color,
  566. direction = direction,
  567. inverse = inverse
  568. )
  569. }
  570. #' @rdname scale_xaringan
  571. #' @export
  572. scale_xaringan_colour_discrete <- scale_xaringan_color_discrete
  573. #' @rdname scale_xaringan
  574. #' @export
  575. scale_xaringan_continuous <- function(
  576. aes_type = c("color", "colour", "fill"),
  577. ...,
  578. color = NULL,
  579. begin = 0,
  580. end = 1,
  581. inverse = FALSE
  582. ) {
  583. requires_package("ggplot2", "scale_xaringan_continuous")
  584. requires_package("scales", "scale_xaringan_continuous")
  585. aes_type <- match.arg(aes_type)
  586. color <- hex2HCL(get_theme_accent_color(color, inverse))
  587. colors <- colorspace::sequential_hcl(
  588. n = 12,
  589. c1 = color[1, "C"],
  590. l1 = color[1, "L"],
  591. h1 = color[1, "H"],
  592. rev = TRUE
  593. )
  594. rescaler <- function(x, ...) {
  595. scales::rescale(x, to = c(begin, end), from = range(x, na.rm = TRUE))
  596. }
  597. ggplot2::continuous_scale(
  598. aes_type,
  599. "continuous_sequential",
  600. palette = scales::gradient_n_pal(colors, values = NULL),
  601. rescaler = rescaler,
  602. oob = scales::censor,
  603. ...
  604. )
  605. }
  606. #' @rdname scale_xaringan
  607. #' @export
  608. scale_xaringan_fill_continuous <- function(
  609. ...,
  610. color = NULL,
  611. begin = 0,
  612. end = 1,
  613. inverse = FALSE
  614. ) {
  615. scale_xaringan_continuous(
  616. "fill",
  617. ...,
  618. color = color,
  619. begin = begin,
  620. end = end,
  621. inverse = inverse
  622. )
  623. }
  624. #' @rdname scale_xaringan
  625. #' @export
  626. scale_xaringan_color_continuous <- function(
  627. ...,
  628. color = NULL,
  629. begin = 0,
  630. end = 1,
  631. inverse = FALSE
  632. ) {
  633. scale_xaringan_continuous(
  634. "color",
  635. ...,
  636. color = color,
  637. begin = begin,
  638. end = end,
  639. inverse = inverse
  640. )
  641. }
  642. #' @rdname scale_xaringan
  643. #' @export
  644. scale_xaringan_colour_continuous <- scale_xaringan_color_continuous
  645. get_theme_accent_color <- function(color = NULL, inverse = FALSE) {
  646. color <-
  647. if (!inverse) {
  648. color %||%
  649. xaringanthemer_env[["header_color"]] %||%
  650. xaringanthemer_env[["text_color"]]
  651. } else {
  652. color %||% xaringanthemer_env[["inverse_header_color"]]
  653. }
  654. if (is.null(color)) {
  655. stop(
  656. call. = FALSE,
  657. "No color provided and no default available. ",
  658. "Have you forgotten to use a style function to set the xaringan theme?"
  659. )
  660. }
  661. color
  662. }
  663. blend_colors <- function(x, y, alpha = 0.5) {
  664. x <- colorspace::hex2RGB(x)
  665. y <- colorspace::hex2RGB(y)
  666. z <- colorspace::mixcolor(alpha, x, y)
  667. colorspace::hex(z)
  668. }
  669. color_blender <- function(x, y) function(alpha = 0.5) blend_colors(x, y, alpha)
  670. hex2HCL <- function(x) {
  671. colorspace::coords(methods::as(colorspace::hex2RGB(x), "polarLUV"))
  672. }
  673. # Fonts -------------------------------------------------------------------
  674. get_theme_font <- function(element = c("text", "header", "code"), use_showtext = TRUE) {
  675. element <- match.arg(element)
  676. element_family <- paste0(element, "_font_family")
  677. element_google <- paste0(element, "_font_google")
  678. element_is_google <- paste0(element, "_font_is_google")
  679. element_url <- paste0(element, "_font_url")
  680. family <- xaringanthemer_env[[element_family]]
  681. is_google_font <- xaringanthemer_env[[element_is_google]]
  682. if (is.null(is_google_font)) {
  683. is_google_font <- !is.null(xaringanthemer_env[[element_google]]) ||
  684. grepl("fonts.google", xaringanthemer_env[[element_url]], fixed = TRUE)
  685. }
  686. register_font(
  687. family,
  688. google = is_google_font,
  689. fn = sys.calls()[[max(1, sys.nframe() - 1)]][[1]],
  690. use_showtext = use_showtext
  691. )
  692. }
  693. register_font <- function(
  694. family,
  695. google = TRUE,
  696. fn = sys.calls()[[max(1, sys.nframe() - 1)]][[1]],
  697. ...,
  698. use_showtext = TRUE
  699. ) {
  700. if (is.null(family) || !use_showtext) {
  701. return(NULL)
  702. }
  703. family <- gsub("['\"]", "", family)
  704. if (!identical(xaringanthemer_env$showtext_auto, TRUE)) {
  705. if (!requires_package(pkg = "showtext", fn, required = FALSE)) {
  706. return(family)
  707. }
  708. showtext::showtext_auto()
  709. xaringanthemer_env$showtext_auto <- TRUE
  710. }
  711. if (family %in% xaringanthemer_env[["registered_font_families"]] %||% "") {
  712. return(family)
  713. }
  714. if (!requires_package(pkg = "sysfonts", fn, required = FALSE)) {
  715. return(family)
  716. } else if (family == "Droid Serif") {
  717. dstmp <- tempfile("droid-serif", fileext = "ttf")
  718. utils::download.file(
  719. "https://github.com/google/fonts/raw/feb15862e0c66ec0e7531ca4c3ef2607071ea700/apache/droidserif/DroidSerif-Regular.ttf",
  720. dstmp,
  721. quiet = TRUE
  722. )
  723. sysfonts::font_add(
  724. family = "Droid Serif",
  725. regular = dstmp
  726. )
  727. } else if (!family %in% sysfonts::font_families()) {
  728. is_default_font <- family %in% c(
  729. "Roboto",
  730. "Source Code Pro",
  731. "Yanone Kaffeesatz"
  732. )
  733. font_found <- family %in% sysfonts::font_families()
  734. is_google_font <- identical(google, TRUE) || (missing(google) && is_default_font)
  735. if (is_google_font) {
  736. tryCatch(
  737. {
  738. sysfonts::font_add_google(family, ...)
  739. font_found <- TRUE
  740. },
  741. error = function(e) {},
  742. warning = function(w) {}
  743. )
  744. }
  745. if (!font_found) { # warn user if font still not found
  746. msg <- if (is_google_font) glue::glue(
  747. "Font '{family}' not found in Google Fonts. ",
  748. "Please manually register the font using `sysfonts::font_add()`."
  749. ) else {
  750. glue::glue(
  751. "Font '{family}' must be manually registered using `sysfonts::font_add()`."
  752. )
  753. }
  754. warning(str_wrap(msg), call. = FALSE)
  755. } else {
  756. verify_fig_showtext(fn)
  757. }
  758. }
  759. xaringanthemer_env[["registered_font_families"]] <- c(
  760. xaringanthemer_env[["registered_font_families"]],
  761. family
  762. )
  763. family
  764. }
  765. verify_fig_showtext <- function(fn = "theme_xaringan_base") {
  766. if (is.null(knitr::current_input())) return()
  767. # Try to set fig.showtext automatically
  768. if (isTRUE(knitr::opts_current$get("fig.showtext"))) {
  769. return()
  770. }
  771. stop(str_wrap(
  772. "To use ", fn, "() with knitr, you need to set the chunk option ",
  773. "`fig.showtext = TRUE` for this chunk. Or you can set this option ",
  774. "globally with `knitr::opts_chunk$set(fig.showtext = TRUE)`."
  775. ))
  776. }
  777. requires_xaringanthemer_env <- function(
  778. css_file = NULL,
  779. try_css = TRUE,
  780. requires_theme = TRUE
  781. ) {
  782. reload <- !is.null(css_file) && isTRUE(try_css)
  783. pkg_env_exists <- exists("xaringanthemer_env")
  784. missing_theme <- requires_theme && pkg_env_exists && is.null(xaringanthemer_env$header_color)
  785. if (reload || !pkg_env_exists || missing_theme) {
  786. if (try_css) {
  787. css_vars <- read_css_vars(css_file)
  788. for (css_var in names(css_vars)) {
  789. xaringanthemer_env[[css_var]] <- css_vars[[css_var]]
  790. }
  791. return(requires_xaringanthemer_env(try_css = FALSE))
  792. } else {
  793. stop("Please call a xaringanthemer theme function first.")
  794. }
  795. }
  796. }
  797. #' Get the Value of xaringanthemer Style Setting
  798. #'
  799. #' A helper function to retrieve the value of style settings as set by a
  800. #' xaringanthemer style function, for use in plotting and other circumstances.
  801. #'
  802. #' @section Style Settings:
  803. #' Style settings used by xaringanthemer include:
  804. #'
  805. #' - `background_color`
  806. #' - `background_image`
  807. #' - `background_position`
  808. #' - `background_size`
  809. #' - `blockquote_left_border_color`
  810. #' - `code_font_family`
  811. #' - `code_font_family_fallback`
  812. #' - `code_font_google`
  813. #' - `code_font_is_google`
  814. #' - `code_font_size`
  815. #' - `code_font_url`
  816. #' - `code_highlight_color`
  817. #' - `code_inline_background_color`
  818. #' - `code_inline_color`
  819. #' - `code_inline_font_size`
  820. #' - `extra_css`
  821. #' - `extra_fonts`
  822. #' - `footnote_color`
  823. #' - `footnote_font_size`
  824. #' - `footnote_position_bottom`
  825. #' - `header_background_auto`
  826. #' - `header_background_color`
  827. #' - `header_background_content_padding_top`
  828. #' - `header_background_ignore_classes`
  829. #' - `header_background_padding`
  830. #' - `header_background_text_color`
  831. #' - `header_color`
  832. #' - `header_font_family`
  833. #' - `header_font_google`
  834. #' - `hedaer_font_is_google`
  835. #' - `header_font_url`
  836. #' - `header_font_weight`
  837. #' - `header_h1_font_size`
  838. #' - `header_h2_font_size`
  839. #' - `header_h3_font_size`
  840. #' - `inverse_background_color`
  841. #' - `inverse_header_color`
  842. #' - `inverse_text_color`
  843. #' - `inverse_text_shadow`
  844. #' - `left_column_selected_color`
  845. #' - `left_column_subtle_color`
  846. #' - `link_color`
  847. #' - `padding`
  848. #' - `table_border_color`
  849. #' - `table_row_border_color`
  850. #' - `table_row_even_background_color`
  851. #' - `text_bold_color`
  852. #' - `text_color`
  853. #' - `text_font_base`
  854. #' - `text_font_family`
  855. #' - `text_font_family_fallback`
  856. #' - `text_font_google`
  857. #' - `text_font_is_google`
  858. #' - `text_font_size`
  859. #' - `text_font_url`
  860. #' - `text_font_weight`
  861. #' - `text_slide_number_color`
  862. #' - `text_slide_number_font_size`
  863. #' - `title_slide_background_color`
  864. #' - `title_slide_background_image`
  865. #' - `title_slide_background_position`
  866. #' - `title_slide_background_size`
  867. #' - `title_slide_text_color`
  868. #'
  869. #' @param setting A xaringanthemer style setting
  870. #' @inheritParams theme_xaringan
  871. #' @export
  872. theme_xaringan_get_value <- function(setting, css_file = NULL) {
  873. requires_xaringanthemer_env(css_file = css_file)
  874. if (length(setting) > 1) {
  875. ret <- list()
  876. for (var in setting) {
  877. ret[[var]] <- xaringanthemer_env[[var]]
  878. }
  879. return(ret)
  880. }
  881. xaringanthemer_env[[setting]]
  882. }
  883. web_to_point <- function(x, px_per_em = NULL, scale = 0.75) {
  884. if (is.null(x)) {
  885. return(NULL)
  886. }
  887. px_per_em <- px_per_em %||% get_base_font_size()
  888. if (grepl("pt$", x)) {
  889. return(as.numeric(sub("pt$", "", x)))
  890. } else if (grepl("px$", x)) {
  891. x <- as.numeric(sub("px$", "", x))
  892. return(x * scale)
  893. } else if (grepl("r?em$", x)) {
  894. x <- as.numeric(sub("r?em$", "", x))
  895. return(x * px_per_em * scale)
  896. } else {
  897. return()
  898. }
  899. }
  900. get_base_font_size <- function() {
  901. base_size <- xaringanthemer_env[["base_font_size"]] %||%
  902. xaringanthemer_env[["text_font_size"]]
  903. if (!grepl("px", base_size)) {
  904. # assume 16px base font size
  905. 16
  906. } else {
  907. as.numeric(sub("px", "", base_size))
  908. }
  909. }