ggthemes/ 0000755 0001762 0000144 00000000000 15113074034 012053 5 ustar ligges users ggthemes/tests/ 0000755 0001762 0000144 00000000000 15112461554 013223 5 ustar ligges users ggthemes/tests/testthat/ 0000755 0001762 0000144 00000000000 15113074034 015055 5 ustar ligges users ggthemes/tests/testthat/test-few.R 0000644 0001762 0000144 00000003122 15112366564 016747 0 ustar ligges users library("ggplot2")
test_that("few_shape_pal works", {
out <- few_shape_pal()
expect_type(out, "closure")
expect_true(!is.null(attr(out, "max_n")))
pal0 <- out(0)
expect_identical(length(pal0), 0L)
pal3 <- out(3)
expect_identical(length(pal3), 3L)
expect_warning(out(10))
})
test_that("few_shape_pal works", {
out <- scale_shape_few()
expect_s3_class(out, c("ScaleDiscrete", "Scale", "ggproto"))
})
test_that("few_pal runs", {
p <- few_pal("Medium")
expect_type(p, "closure")
expect_type(attr(p, "max_n"), "integer")
out <- p(5)
expect_type(out, "character")
expect_equal(length(out), 5L)
# should use the first accent color
expect_equal(
out[[1]],
ggthemes::ggthemes_data$few$colors$Medium$value[[2]]
)
expect_warning(p(10))
})
test_that("few_pal works with n = 1", {
out <- few_pal("Medium")(1)
expect_equal(out, ggthemes::ggthemes_data$few$colors$Medium$value[[1]])
})
test_that("few_pal raises error with bad palette", {
expect_error(few_pal("Foo"))
})
test_that("scale_colour_few works", {
expect_s3_class(scale_colour_few(), "ScaleDiscrete")
})
test_that("scale_color_few works", {
expect_equal_scale(scale_color_few(), scale_colour_few())
})
test_that("scale_fill_few works", {
expect_s3_class(scale_fill_few(), "ScaleDiscrete")
})
test_that("theme_few works", {
expect_s3_class(theme_few(), "theme")
})
test_that("theme_few draws correctly", {
df <- data.frame(x = 1:3, y = 1:3, z = c("a", "b", "a"), a = 1)
plot <- ggplot(df, aes(x, y, colour = z)) +
geom_point() +
facet_wrap(~a)
expect_doppelganger("theme_few", plot)
})
ggthemes/tests/testthat/test-colorblind.R 0000644 0001762 0000144 00000000742 15112676746 020330 0 ustar ligges users test_that("colorblind_pal works", {
p <- colorblind_pal()
expect_type(p, "closure")
expect_hexcolor(p(4))
expect_type(attr(p, "max_n"), "integer")
})
test_that("colorblind_pal raises warning with to large n", {
expect_warning(colorblind_pal()(20))
})
test_that("scale_colour_colourblind works", {
expect_s3_class(scale_colour_colourblind(), "ScaleDiscrete")
})
test_that("scale_fill_colorblind works", {
expect_s3_class(scale_fill_colorblind(), "ScaleDiscrete")
})
ggthemes/tests/testthat/test-banking.R 0000644 0001762 0000144 00000001232 15112366564 017577 0 ustar ligges users test_that("bank_slopes runs", {
x <- 1:5
y <- runif(length(x))
out <- bank_slopes(x, y)
expect_equal(length(out), 1L)
expect_type(out, "double")
})
test_that("bank_slopes with method=\"as\" runs", {
x <- 1:5
y <- runif(length(x))
out <- bank_slopes(x, y, method = "as")
expect_equal(length(out), 1L)
expect_type(out, "double")
})
test_that("bank_slopes with invalid method throws error", {
expect_error(bank_slopes(1:5, 1:5, method = "aor"))
})
test_that("bank_slopes works with cull = TRUE", {
x <- c(1, 1, 2)
y <- runif(length(x))
out <- bank_slopes(x, y, cull = TRUE)
expect_equal(length(out), 1L)
expect_type(out, "double")
})
ggthemes/tests/testthat/test-shapes.R 0000644 0001762 0000144 00000003125 15112461554 017447 0 ustar ligges users test_that("circlefill_pal works", {
expect_snapshot({
pal <- circlefill_shape_pal()
expect_type(pal, "closure")
expect_equal(attr(pal, "max_n"), 5L)
n <- 4L
values <- pal(n)
expect_type(values, "integer")
expect_equal(length(values), n)
})
})
test_that("scale_shape_circlefill works", {
expect_snapshot({
expect_s3_class(scale_shape_circlefill(), "ScaleDiscrete")
})
})
test_that("tremmel_shape_pal works", {
pal <- tremmel_shape_pal()
expect_type(pal, "closure")
expect_equal(attr(pal, "max_n"), 3L)
n <- 3L
values <- pal(n)
expect_type(values, "integer")
expect_equal(length(values), n)
})
test_that("tremmel_shape_pal works for all values", {
for (i in 1:3L) {
expect_equal(length(tremmel_shape_pal()(i)), i)
expect_equal(length(tremmel_shape_pal(alt = TRUE)(i)), i)
expect_equal(length(tremmel_shape_pal(overlap = TRUE)(i)), i)
}
})
test_that("scale_shape_tremmel works", {
expect_s3_class(scale_shape_tremmel(), "ScaleDiscrete")
})
test_that("cleveland_shape_pal works", {
pal <- cleveland_shape_pal()
expect_type(pal, "closure")
expect_equal(attr(pal, "max_n"), 4)
n <- 3
vals <- pal(n)
expect_equal(length(vals), n)
})
test_that("cleveland_shape_pal works with overlap = FALSE", {
pal <- cleveland_shape_pal(overlap = FALSE)
expect_type(pal, "closure")
expect_equal(attr(pal, "max_n"), 5)
n <- 3
vals <- pal(n)
expect_equal(length(vals), n)
expect_type(vals, "integer")
expect_true(all(vals < 0))
})
test_that("scale_shape_cleveland works", {
expect_s3_class(scale_shape_cleveland(), "ScaleDiscrete")
})
ggthemes/tests/testthat/test-show.R 0000644 0001762 0000144 00000000622 15112366564 017150 0 ustar ligges users test_that("show_shapes works", {
# creates plot using base plotting system, so just run code --- any
# errors / warnings will be caught.
x <- 1:10
expect_equal(show_shapes(x), x)
})
test_that("show_linetypes works", {
x <- 1:5
expect_equal(show_linetypes(x), x)
})
test_that("show_linetypes works with labels = FALSE", {
x <- 1:5
expect_equal(show_linetypes(x, labels = FALSE), x)
})
ggthemes/tests/testthat/test-excel.R 0000644 0001762 0000144 00000002705 15112366564 017274 0 ustar ligges users test_that("excel_clasic_pal works", {
pal <- excel_pal()
n <- 5L
values <- pal(n)
expect_type(values, "character")
expect_equal(length(values), n)
})
test_that("excel_clasic_pal with line = TRUE works", {
pal <- excel_pal(line = TRUE)
n <- 5L
values <- pal(n)
expect_type(values, "character")
expect_equal(length(values), n)
})
test_that("calc_shape_pal raises warning for large n", {
expect_warning(excel_pal()(8))
})
test_that("excel_new_pal works", {
pal <- excel_new_pal()
n <- 5L
vals <- pal(n)
expect_type(vals, "character")
expect_equal(length(vals), n)
})
test_that("excel_new_pal raises error for bad n", {
expect_warning(excel_new_pal()(7))
})
test_that("theme_excel works", {
expect_s3_class(theme_excel(), "theme")
})
test_that("excel_new_pal raises error with bad theme name", {
expect_error(excel_new_pal("adfaasdfa"), regexp = "`theme` must be one of")
})
test_that("scale_fill_excel works", {
expect_s3_class(scale_fill_excel(), "ScaleDiscrete")
})
test_that("scale_colour_excel works", {
expect_s3_class(scale_colour_excel(), "ScaleDiscrete")
})
test_that("scale_colour_excel works", {
expect_s3_class(scale_fill_excel_new(), "ScaleDiscrete")
})
test_that("scale_fill_excel works", {
expect_s3_class(scale_colour_excel_new(), "ScaleDiscrete")
})
test_that("theme_excel with horizontal = FALSE works", {
thm <- theme_excel(horizontal = FALSE)
expect_equal(thm$panel.grid.major.y, element_blank())
})
ggthemes/tests/testthat/test-geom-rangeframe.R 0000644 0001762 0000144 00000000136 15112366564 021224 0 ustar ligges users test_that("geom_rangeframe works", {
expect_s3_class(geom_rangeframe(), "LayerInstance")
})
ggthemes/tests/testthat/test-stat_fivenumber.R 0000644 0001762 0000144 00000000136 15112366564 021365 0 ustar ligges users test_that("stat_fivenumber works", {
expect_s3_class(stat_fivenumber(), "LayerInstance")
})
ggthemes/tests/testthat/test-pander.R 0000644 0001762 0000144 00000001627 15112366564 017447 0 ustar ligges users test_that("scale_colour_pander works", {
expect_s3_class(scale_colour_pander(), "ScaleDiscrete")
})
test_that("scale_fill_pander works", {
expect_s3_class(scale_fill_pander(), "ScaleDiscrete")
})
test_that("palette_pander works", {
colors <- palette_pander(5)
expect_hexcolor(colors)
})
test_that("palette_pander random_order=TRUE works", {
colors <- palette_pander(5, random_order = TRUE)
expect_hexcolor(colors)
})
test_that("theme_pander works", {
expect_s3_class(theme_pander(), "theme")
})
test_that("theme_pander works with gm = FALSE", {
thm <- theme_pander(gM = FALSE)
expect_s3_class(thm, "theme")
expect_equal(thm$panel.grid, element_blank())
})
test_that("theme_pander warns about ff argument", {
expect_warning(theme_pander(ff = ""), regexp = "deprecated")
})
test_that("theme_pander warns about fs argument", {
expect_warning(theme_pander(fs = 1), regexp = "deprecated")
})
ggthemes/tests/testthat/test-solarized.R 0000644 0001762 0000144 00000001466 15112366564 020173 0 ustar ligges users test_that("theme_solarized_works", {
expect_s3_class(theme_solarized(), "theme")
expect_s3_class(theme_solarized(light = FALSE), "theme")
})
test_that("theme_solarized_2_works", {
expect_s3_class(theme_solarized_2(), "theme")
expect_s3_class(theme_solarized_2(light = FALSE), "theme")
})
test_that("scale_colour_solarized works", {
expect_s3_class(scale_colour_solarized(), "ScaleDiscrete")
})
test_that("scale_color_solarized works", {
expect_equal_scale(scale_colour_solarized(), scale_color_solarized())
})
test_that("scale_fill_solarized works", {
expect_s3_class(scale_fill_solarized(), "ScaleDiscrete")
})
test_that("solarized_pal works", {
pal <- solarized_pal()
expect_type(pal, "closure")
n <- 5L
values <- pal(n)
expect_type(values, "character")
expect_equal(length(values), n)
})
ggthemes/tests/testthat/test-tufteboxplot.R 0000644 0001762 0000144 00000000142 15112366564 020724 0 ustar ligges users test_that("geom_tufteboxplot works", {
expect_s3_class(geom_tufteboxplot(), "LayerInstance")
})
ggthemes/tests/testthat/test-theme_map.R 0000644 0001762 0000144 00000000215 15112366564 020125 0 ustar ligges users test_that("theme_map works", {
thm <- theme_map()
expect_s3_class(thm, "theme")
expect_equal(thm$panel.background, element_blank())
})
ggthemes/tests/testthat/test-canva.R 0000644 0001762 0000144 00000001334 15112366564 017261 0 ustar ligges users test_that("canva_pal works", {
p <- canva_pal()
expect_type(p, "closure")
expect_hexcolor(p(4))
})
test_that("canva_pal works with alt palette", {
expect_hexcolor(canva_pal("Pop art")(4))
})
test_that("canva_pal raises warning with to large n", {
expect_warning(canva_pal()(10))
})
test_that("canva_pal raises error with invalid palette", {
expect_error(canva_pal("adsffafd"), regexp = "not a valid name")
})
test_that("scale_colour_canva works", {
expect_s3_class(scale_colour_canva(), "ScaleDiscrete")
})
test_that("scale_color_canva works", {
expect_equal_scale(scale_color_canva(), scale_colour_canva())
})
test_that("scale_colour_canva works", {
expect_s3_class(scale_fill_canva(), "ScaleDiscrete")
})
ggthemes/tests/testthat/test-wsj_pal.R 0000644 0001762 0000144 00000001140 15112366564 017623 0 ustar ligges users test_that("theme_wsj works", {
expect_s3_class(theme_wsj(), "theme")
})
test_that("wsj_pal works", {
p <- wsj_pal()
expect_type(p, "closure")
expect_type(attr(p, "max_n"), "integer")
expect_hexcolor(p(3))
})
test_that("theme_wsj works", {
expect_s3_class(theme_wsj(), "theme")
})
test_that("theme_wsj raises error with invalid palette", {
expect_error(wsj_pal("asdgasa"), regexp = "valid palette")
})
test_that("scale_colour_wsj works", {
expect_s3_class(scale_colour_wsj(), "ScaleDiscrete")
})
test_that("scale_fill_wsj works", {
expect_s3_class(scale_fill_wsj(), "ScaleDiscrete")
})
ggthemes/tests/testthat/test-tableau.R 0000644 0001762 0000144 00000006530 15112461554 017604 0 ustar ligges users test_that("tableau_color_pal works", {
pal <- tableau_color_pal()
expect_type(pal, "closure")
expect_type(attr(pal, "max_n"), "integer")
n <- 3
vals <- pal(n)
expect_type(vals, "character")
expect_equal(length(vals), n)
})
test_that("tableau_color_pal direction = -1 works", {
n <- 4L
expect_true(all(tableau_color_pal(direction = -1)(n) == rev(tableau_color_pal()(n))))
})
test_that("tableau_color_pal works with diverging palette", {
n <- 3L
pal <- tableau_color_pal("Orange-Blue Diverging", type = "ordered-diverging")(n)
expect_type(pal, "character")
expect_equal(length(pal), n)
})
test_that("tableau_color_pal raises error with invalid palette", {
expect_error(tableau_color_pal("dsaga"))
})
test_that("tableau_shape_pal raises error with bad palette", {
expect_error(tableau_shape_pal(palette = "gender"))
})
test_that("tableau_shape_pal works", {
n <- 3
pal <- tableau_shape_pal()(n)
expect_type(pal, "integer")
expect_type(attr(tableau_shape_pal(), "max_n"), "integer")
# all unicode
expect_true(all(pal < 0))
expect_equal(length(pal), n)
})
test_that("scale_shape_tableau works", {
expect_s3_class(scale_shape_tableau(), "ScaleDiscrete")
})
test_that("scale_colour_tableau works", {
expect_s3_class(scale_colour_tableau(), "ScaleDiscrete")
})
test_that("scale_colour_tableau works with diverging scales", {
expect_s3_class(
scale_colour_tableau(
type = "ordered-diverging",
palette = "Orange-Blue Diverging"
),
"ScaleDiscrete"
)
})
test_that("scale_colour_tableau works with sequential scales", {
expect_s3_class(
scale_colour_tableau(
type = "ordered-sequential",
palette = "Blue-Green Sequential"
),
"ScaleDiscrete"
)
})
test_that("scale_fill_tableau works", {
expect_s3_class(scale_fill_tableau(), "ScaleDiscrete")
})
test_that("scale_fill_tableau works with diverging scales", {
expect_s3_class(
scale_fill_tableau(
type = "ordered-diverging",
palette = "Orange-Blue Diverging"
),
"ScaleDiscrete"
)
})
test_that("scale_fill_tableau works with sequential scales", {
expect_s3_class(
scale_fill_tableau(
type = "ordered-sequential",
palette = "Blue-Green Sequential"
),
"ScaleDiscrete"
)
})
test_that("tableau_gradient_pal works", {
p <- tableau_gradient_pal()
expect_type(p, "closure")
expect_hexcolor(p(seq(0, 1, by = 0.1)))
})
test_that("tableau_seq_gradient_pal works", {
p <- tableau_seq_gradient_pal()
expect_type(p, "closure")
expect_hexcolor(p(seq(0, 1, by = 0.1)))
})
test_that("tableau_div_gradient_pal works", {
p <- tableau_seq_gradient_pal()
expect_type(p, "closure")
expect_hexcolor(p(seq(0, 1, by = 0.1)))
})
test_that("scale_colour_gradient_tableau works", {
expect_s3_class(scale_colour_gradient_tableau(), "ScaleContinuous")
})
test_that("scale_fill_gradient_tableau works", {
expect_s3_class(scale_fill_gradient_tableau(), "ScaleContinuous")
})
test_that("scale_colour_gradient_tableau works", {
expect_s3_class(scale_colour_gradient2_tableau(), "ScaleContinuous")
})
test_that("scale_fill_gradient_tableau works", {
expect_s3_class(scale_fill_gradient2_tableau(), "ScaleContinuous")
})
test_that("classic colors are in the correct order", {
# Issue #96
pal <- tableau_color_pal("Classic 20")(20)
expect_equal(pal[[1]], "#1f77b4")
expect_equal(pal[[20]], "#9edae5")
})
ggthemes/tests/testthat/helper-utils.R 0000644 0001762 0000144 00000001116 15112366564 017627 0 ustar ligges users library("testthat")
is_hexcolor <- function(x) {
pattern <- stringr::regex("^#[a-f0-9]{6}$", ignore_case = TRUE)
out <- stringr::str_detect(x, pattern)
out[is.na(out)] <- FALSE
out
}
expect_hexcolor <- function(object) {
# capture object and label
act <- quasi_label(rlang::enquo(object))
valid <- is_hexcolor(act$val)
expect(
all(valid),
glue::glue("Not all elements of {act$lab} are hex colors.")
)
invisible(act$val)
}
expect_equal_scale <- function(x, y, ...) {
x <- as.list(x)
y <- as.list(y)
x$call <- y$call <- NULL
expect_equal(x, y, ...)
}
ggthemes/tests/testthat/test-igray.R 0000644 0001762 0000144 00000000216 15112366564 017302 0 ustar ligges users test_that("theme_igray works", {
thm <- theme_igray()
expect_s3_class(thm, "theme")
expect_equal(thm$plot.background$fill, "gray90")
})
ggthemes/tests/testthat/test-economist.R 0000644 0001762 0000144 00000003565 15112461554 020174 0 ustar ligges users test_that("economist_pal fill=FALSE works", {
p <- economist_pal(fill = FALSE)
expect_type(p, "closure")
for (i in 1:9) {
expect_hexcolor(p(i))
}
})
test_that("economist_pal fill=TRUE works", {
p <- economist_pal(fill = TRUE)
expect_type(p, "closure")
for (i in 1:9) {
expect_hexcolor(p(i))
}
})
test_that("economist_pal raises warning with large number", {
expect_warning(economist_pal()(10))
})
test_that("scale_colour_economist equals scale_color_economist", {
expect_equal_scale(scale_color_economist(), scale_colour_economist())
})
test_that("scale_colour_economist works", {
expect_s3_class(scale_color_economist(), "ScaleDiscrete")
})
test_that("scale_fill_economist works", {
expect_s3_class(scale_fill_economist(), "ScaleDiscrete")
})
test_that("theme economist works", {
expect_s3_class(theme_economist(), "theme")
})
test_that("theme economist with horizontal=FALSE works", {
thm <- theme_economist(horizontal = FALSE)
expect_s3_class(thm, "theme")
expect_equal(thm$panel.grid.major.y, element_blank())
})
test_that("theme economist with dark panel works", {
thm <- theme_economist(dkpanel = TRUE)
expect_s3_class(thm, "theme")
expect_equal(
thm$strip.background$fill,
purrr::pluck(
dplyr::filter(
ggthemes_data$economist$bg,
name == "dark blue-gray"
),
"value"
)
)
})
test_that("theme economist_white works", {
thm <- theme_economist_white(gray_bg = FALSE)
expect_equal(thm$panel.background$fill, "white")
expect_equal(thm$plot.background$fill, "white")
})
test_that("theme economist_white with gray background works", {
thm <- theme_economist_white(gray_bg = TRUE)
expect_s3_class(thm, "theme")
expect_equal(
thm$plot.background$fill,
purrr::pluck(
dplyr::filter(
ggthemes_data$economist$bg,
name == "light gray"
),
"value"
)
)
})
ggthemes/tests/testthat/helper-vdiffr.R 0000644 0001762 0000144 00000000333 15112366564 017747 0 ustar ligges users expect_doppelganger <- function(title, fig, path = NULL) {
# need to call conditionally because vdiffr listed in Suggests (#124)
testthat::skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger(title, fig)
}
ggthemes/tests/testthat/test-theme_solid.R 0000644 0001762 0000144 00000000214 15112366564 020461 0 ustar ligges users test_that("theme_solid works", {
thm <- theme_solid(fill = "red")
expect_s3_class(thm, "theme")
expect_equal(thm$rect$fill, "red")
})
ggthemes/tests/testthat/test-ptol.R 0000644 0001762 0000144 00000000525 15112366564 017150 0 ustar ligges users test_that("ptol_pal works", {
p <- ptol_pal()
expect_type(p, "closure")
expect_type(attr(p, "max_n"), "integer")
expect_hexcolor(p(11))
})
test_that("scale_colour_ptol works", {
expect_s3_class(scale_colour_ptol(), "ScaleDiscrete")
})
test_that("scale_fill_ptol works", {
expect_s3_class(scale_fill_ptol(), "ScaleDiscrete")
})
ggthemes/tests/testthat/test-tufte.R 0000644 0001762 0000144 00000000407 15112366564 017320 0 ustar ligges users test_that("theme_tufte works", {
thm <- theme_tufte()
expect_s3_class(thm, "theme")
})
test_that("theme_tufte works with ticks = FALSE", {
thm <- theme_tufte(ticks = FALSE)
expect_s3_class(thm, "theme")
expect_equal(thm$axis.ticks, element_blank())
})
ggthemes/tests/testthat/test-calc.R 0000644 0001762 0000144 00000001670 15112366564 017076 0 ustar ligges users test_that("calc_shape_pal works", {
pal <- calc_shape_pal()
expect_type(pal, "closure")
expect_type(attr(pal, "max_n"), "integer")
n <- 5L
shapes <- pal(n)
expect_type(shapes, "integer")
expect_true(all(shapes < 0))
expect_equal(length(shapes), n)
})
test_that("calc_pal works", {
pal <- calc_pal()
expect_type(pal, "closure")
expect_type(attr(pal, "max_n"), "integer")
n <- 5L
expect_hexcolor(pal(n))
expect_warning(pal(100))
expect_error(pal(-1))
})
test_that("calc_shape_pal raises warning for large n", {
expect_warning(calc_shape_pal()(100))
})
test_that("theme_calc works", {
expect_s3_class(theme_calc(), "theme")
})
test_that("scale_colour_calc works", {
expect_s3_class(scale_colour_calc(), "ScaleDiscrete")
})
test_that("scale_fill_calc works", {
expect_s3_class(scale_fill_calc(), "ScaleDiscrete")
})
test_that("scale_shape_calc works", {
expect_s3_class(scale_shape_calc(), "ScaleDiscrete")
})
ggthemes/tests/testthat/_snaps/ 0000755 0001762 0000144 00000000000 15112366564 016353 5 ustar ligges users ggthemes/tests/testthat/_snaps/few/ 0000755 0001762 0000144 00000000000 15112366564 017134 5 ustar ligges users ggthemes/tests/testthat/_snaps/few/theme-few.svg 0000644 0001762 0000144 00000014756 15112366564 021553 0 ustar ligges users
ggthemes/tests/testthat/_snaps/shapes.md 0000644 0001762 0000144 00000001205 15112366564 020156 0 ustar ligges users # circlefill_pal works
Code
pal <- circlefill_shape_pal()
Condition
Warning:
`circlefill_shape_pal()` was deprecated in ggthemes 5.0.0.
Code
expect_type(pal, "closure")
expect_equal(attr(pal, "max_n"), 5L)
n <- 4L
values <- pal(n)
expect_type(values, "integer")
expect_equal(length(values), n)
# scale_shape_circlefill works
Code
expect_s3_class(scale_shape_circlefill(), "ScaleDiscrete")
Condition
Warning:
`scale_shape_circlefill()` was deprecated in ggthemes 5.0.0.
Warning:
`circlefill_shape_pal()` was deprecated in ggthemes 5.0.0.
ggthemes/tests/testthat/test-fivethirtyeight.R 0000644 0001762 0000144 00000000771 15112366564 021413 0 ustar ligges users test_that("theme_fivethirtyeight works", {
expect_s3_class(theme_fivethirtyeight(), "theme")
})
test_that("scale_fill_fivethirtyeight works", {
expect_s3_class(scale_fill_fivethirtyeight(), "ScaleDiscrete")
})
test_that("scale_colour_fivethirtyeight works", {
expect_s3_class(scale_colour_fivethirtyeight(), "ScaleDiscrete")
})
test_that("fivethirtyeight_pal works", {
p <- fivethirtyeight_pal()
expect_type(p, "closure")
expect_type(attr(p, "max_n"), "integer")
expect_hexcolor(p(3))
})
ggthemes/tests/testthat/test-stata.R 0000644 0001762 0000144 00000002760 15112461554 017304 0 ustar ligges users test_that("stata_pal works", {
p <- stata_pal()
expect_type(p, "closure")
expect_type(attr(p, "max_n"), "integer")
n <- 5
vals <- p(n)
expect_hexcolor(vals)
expect_length(vals, n)
expect_warning(stata_pal()(100))
})
test_that("scale_colour_stata works", {
expect_s3_class(scale_colour_stata(), "ScaleDiscrete")
})
test_that("scale_color_stata works", {
expect_equal_scale(scale_colour_stata(), scale_color_stata())
})
test_that("scale_fill_stata works", {
expect_s3_class(scale_fill_stata(), "ScaleDiscrete")
})
test_that("scale_shape_stata works", {
expect_s3_class(scale_shape_stata(), "ScaleDiscrete")
})
test_that("theme_stata works", {
expect_s3_class(theme_stata(), "theme")
for (i in c("s2mono", "s1mono", "s2manual", "s1rcolor", "s1color")) {
expect_s3_class(theme_stata(scheme = i), "theme")
}
})
test_that("theme_state raises error with invallid scheme", {
expect_error(theme_stata(scheme = "dsagasagdadgaga"), regexp = "`scheme` must be one of")
})
test_that("stata_shape_pal works", {
p <- stata_shape_pal()
expect_type(p, "closure")
n <- 5L
vals <- p(n)
expect_type(vals, "integer")
expect_length(vals, n)
expect_true(all(vals < 0))
expect_warning(p(100))
})
test_that("stata_linetype_pal works", {
p <- stata_linetype_pal()
expect_type(p, "closure")
n <- 5L
vals <- p(n)
expect_equal(vals, c("solid", "84", "23", "F414", "F4"))
})
test_that("scale_linetype_stata works", {
expect_s3_class(scale_linetype_stata(), "ScaleDiscrete")
})
ggthemes/tests/testthat/test-gdocs.R 0000644 0001762 0000144 00000001056 15112366564 017271 0 ustar ligges users test_that("gdocs_pal works", {
pal <- gdocs_pal()
expect_type(pal, "closure")
n <- 3
vals <- pal(n)
expect_type(vals, "character")
expect_equal(length(vals), n)
})
test_that("scale_fill_gdocs works", {
expect_s3_class(scale_fill_gdocs(), "ScaleDiscrete")
})
test_that("scale_colour_gdocs works", {
expect_s3_class(scale_fill_gdocs(), "ScaleDiscrete")
})
test_that("scale_color_gdocs works", {
expect_equal_scale(scale_color_gdocs(), scale_colour_gdocs())
})
test_that("theme_gdocs works", {
expect_s3_class(theme_gdocs(), "theme")
})
ggthemes/tests/testthat/test-base.R 0000644 0001762 0000144 00000002356 15112366564 017110 0 ustar ligges users test_that("theme_base runs", {
expect_s3_class(theme_base(), "theme")
})
test_that("theme_par runs", {
expect_s3_class(theme_par(), "theme")
})
test_that("theme_par recognizes las", {
withr::with_par(list(las = 1), {
thm <- theme_par()
expect_equal(thm$axis.title.x$angle, 0)
expect_equal(thm$axis.title.y$angle, 0)
})
withr::with_par(list(las = 2), {
thm <- theme_par()
expect_equal(thm$axis.title.x$angle, 90)
expect_equal(thm$axis.title.y$angle, 0)
})
withr::with_par(list(las = 3), {
thm <- theme_par()
expect_equal(thm$axis.title.x$angle, 90)
expect_equal(thm$axis.title.y$angle, 90)
})
})
test_that("theme_par recognizes tck", {
withr::with_par(list(tck = 1), {
expect_equal(theme_par()$axis.ticks.length, grid::unit(-1, "snpc"))
})
})
test_that("theme_par recognizes xaxt", {
withr::with_par(list(xaxt = "n"), {
thm <- theme_par()
for (i in c("axis.line.x", "axis.text.x", "axis.ticks.x")) {
expect_equal(thm[[i]], element_blank())
}
})
})
test_that("theme_par recognizes yaxt", {
withr::with_par(list(yaxt = "n"), {
thm <- theme_par()
for (i in c("axis.line.y", "axis.text.y", "axis.ticks.y")) {
expect_equal(thm[[i]], element_blank())
}
})
})
ggthemes/tests/testthat/test-hc.R 0000644 0001762 0000144 00000001507 15112461554 016560 0 ustar ligges users test_that("hc_pal works", {
pal <- hc_pal()
expect_type(pal, "closure")
n <- 5
values <- pal(n)
expect_type(values, "character")
expect_equal(length(values), n)
})
test_that("hc_pal raises error with invalid palette", {
expect_error(hc_pal(palette = "asdgasdgasdgas"), regexp = "not valid")
})
test_that("scale_colour_hc works", {
expect_s3_class(scale_colour_hc(), "ScaleDiscrete")
})
test_that("scale_color_hc works", {
expect_equal_scale(scale_colour_hc(), scale_color_hc())
})
test_that("scale_fill_hc works", {
expect_s3_class(scale_fill_hc(), "ScaleDiscrete")
})
test_that("theme_hc works", {
expect_s3_class(theme_hc(), "theme")
expect_s3_class(theme_hc(style = "darkunica"), "theme")
})
test_that("bgcolor raises warning", {
expect_warning(theme_hc(bgcolor = "darkunica"), regexp = "deprecated")
})
ggthemes/tests/testthat.R 0000644 0001762 0000144 00000000614 15112366564 015214 0 ustar ligges users # This file is part of the standard setup for testthat.
# It is recommended that you do not modify it.
#
# Where should you do additional test configuration?
# Learn more about the roles of various files in:
# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
# * https://testthat.r-lib.org/articles/special-files.html
library(testthat)
library(ggthemes)
test_check("ggthemes")
ggthemes/tests/spelling.R 0000644 0001762 0000144 00000000231 15112461554 015157 0 ustar ligges users if (requireNamespace("spelling", quietly = TRUE)) {
spelling::spell_check_test(
vignettes = TRUE,
error = FALSE,
skip_on_cran = TRUE
)
}
ggthemes/tests/figs/ 0000755 0001762 0000144 00000000000 15112366564 014160 5 ustar ligges users ggthemes/tests/figs/few/ 0000755 0001762 0000144 00000000000 15112366564 014741 5 ustar ligges users ggthemes/tests/figs/few/theme-few.svg 0000644 0001762 0000144 00000020352 15112366564 017345 0 ustar ligges users
ggthemes/tests/figs/deps.txt 0000644 0001762 0000144 00000000103 15112366564 015646 0 ustar ligges users - vdiffr-svg-engine: 1.0
- vdiffr: 0.3.0
- freetypeharfbuzz: 0.2.5
ggthemes/MD5 0000644 0001762 0000144 00000032375 15113074034 012375 0 ustar ligges users fbae4789ff91cb5ab0cde82f95798e0b *DESCRIPTION
79fbd463759aaf4b69bc4a3def0d2359 *NAMESPACE
b127821cdbc5e51033de48590b7b0597 *NEWS.md
785e1449823ac76c4e843e4347fe0a5e *R/banking.R
4ecdeeaa1dbc9bcaf3de781439d3c2e9 *R/base.R
2fb8e6c874e016f1fad60f50a6b6b74d *R/calc.R
836d57e3b2bfe00bce6f6d956be2d0e4 *R/canva.R
b7d4928373d34cbdb263b968874f0b72 *R/clean.R
cd1dd047edac73ffe67cc6458da04b72 *R/colorblind.R
0a790dced01c7386149312d2aa959a76 *R/economist.R
7f557c114fc11619f4bf4469c6a9991e *R/excel.R
3f27224bb615ce3b50374f0e3f7a7e17 *R/few.R
d75cae901d7a7ae77a769c7ca5724934 *R/fivethirtyeight.R
8604b6bb1b4a3b71149bf3140ddac2a4 *R/gdocs.R
d887844c4a94a90d92965660cf152a65 *R/geom-rangeframe.R
6d9dbb5988abd3e5f48586590a37876b *R/geom-tufteboxplot.R
cbdcec08a2412b2bd88ad2366e0ddec2 *R/ggthemes-package.R
a37b58e707a70274853206ae66f7f668 *R/ggthemes_data.R
42b992794c93c52834738a57be4425b0 *R/hc.R
0086279001e447344aaf6a2079e10410 *R/igray.R
7653b750c6ead255678e9b1a11ed20c4 *R/pander.R
44bf5f8a4f9b0a22847a11f6c1b0776e *R/ptol.R
11902745ea6d0efb9ab2e6a2e0f370a4 *R/scales.R
60e16a0e4b760ef58d6e152e48d06e02 *R/shapes.R
a12630ec5663b7ab72cb17bf0c195da2 *R/show.R
5eb871291c6de2afb5b1e73a42c49bba *R/solarized.R
8d053b0c4d6cf0d56b995f71199681c6 *R/stat-fivenumber.R
601d7dfdda2fc304c1c4e3e3a52c2876 *R/stata.R
bf47edf4cd74ba21d22eb17f6be1445c *R/tableau.R
e4d4cda0e036495588d9c0287c7c90ef *R/theme-foundation.R
00df866f0374fe66cff41153b191e02b *R/theme-map.R
2da441918bf6da02c5f0618be7138ad6 *R/theme-solid.R
ef8eed1125f41742904a23eeff60c2c6 *R/tufte.R
cb5e27c776fcf01867310258b9c629ff *R/utils.R
da58f576672983d058c93774b1a324d4 *R/wsj.R
79b63005faab3f7bfedc286944f3eb56 *build/stage23.rdb
0ca3d6ffdc8f782e707f4c5e4e7779da *data/canva_palettes.rda
7dd53bfb17a6c9e2da330db96d475985 *data/ggthemes_data.rda
094188fa63f0e561551f1fa3acbca62b *inst/WORDLIST
61b5b0663c0fbfd698ceec6d30a61495 *inst/examples/ex-bank_slopes.R
8a7aa608a3f27bf71ee394e6904072d6 *inst/examples/ex-calc_pal.R
e0d8396e5c078661c917db2416b0ad01 *inst/examples/ex-calc_shape_pal.R
34050b8767ef16fec1c8333c639f895d *inst/examples/ex-canva_pal.R
b5a60817ad9d91b9e299ecea995c37a8 *inst/examples/ex-cleveland_shape_pal.R
cb2ffaaad167c0760d28e527c3c83a59 *inst/examples/ex-colorblind.R
b898bc5dce52c5825d16f46cc726fbf6 *inst/examples/ex-economist_pal.R
b7fc2896898242ae68eb972ece9e5cf5 *inst/examples/ex-excel_new_pal.R
4953d0c35f4bda05bfd2e042d9cbdf20 *inst/examples/ex-excel_pal.R
d4e6105c9128ac31dfaa5c895dbffc2d *inst/examples/ex-few_pal.R
97916233fd580dfdb6a472114b64d620 *inst/examples/ex-few_shape_pal.R
92e42499c32654ce543da988e6f1ab56 *inst/examples/ex-fivethirtyeight_pal.R
9905e88fe37aaef84840d77449679b07 *inst/examples/ex-gdocs_pal.R
ec5c78ce946ce77ab8bb4812098396a2 *inst/examples/ex-geom_rangeframe.R
45e89b2e920219b70fb4fcfcc7fdf366 *inst/examples/ex-geom_tufteboxplot.R
8c5d0c33430555668fe9d0ceb37bf981 *inst/examples/ex-palette_pander.R
aa47cf7e65727cf425fe694dd017bafa *inst/examples/ex-ptol_pal.R
dc202b8d058a26ae1c0810bf3e22b1f6 *inst/examples/ex-scale_color_tableau.R
88388911ca9e7570d4ef2b8ec587d631 *inst/examples/ex-scale_colour_excel_classic.R
b895f8190ea94e4d742cddecf494dcc9 *inst/examples/ex-scale_colour_excel_new.R
6e49e4b8fe66442710d94f372dbcca93 *inst/examples/ex-scale_colour_gradient2_tableau.R
6c3c1a657544d0397357f4665e82af99 *inst/examples/ex-scale_colour_gradient_tableau.R
a9d71c1910ed43d147f1ff9a0d047856 *inst/examples/ex-scale_colour_ptol.R
cb35e002caab3906e7870e36c0042aaa *inst/examples/ex-scale_linetype_stata.R
aab0dfe35a113ebb095893f7a2ece1e5 *inst/examples/ex-scale_shape_stata.R
bc9448ea74b6b85034ba6befdf495a28 *inst/examples/ex-scale_shape_tableau.R
1b7f685f9eb20fa89b89a11f26e3771e *inst/examples/ex-scale_shape_tremmel.R
0778b556edeb11289dfcb201e8c2c291 *inst/examples/ex-scale_solarized.R
088fbcb5ac12612aa1bf093a4a83e254 *inst/examples/ex-show_linetypes.R
7c24ec130d3ab12da38f38ef0b95029c *inst/examples/ex-show_shapes.R
1c8bbf7be026119b96a1beff3cc89770 *inst/examples/ex-solarized_pal.R
060f798e1f83b45edd335f086cbe86cd *inst/examples/ex-stata_pal.R
83c80b7ac0f626e90e0855ff37034b7f *inst/examples/ex-tableau_color_pal.R
12592f3d0b8dbcbc498bf8a0228e3af3 *inst/examples/ex-tableau_div_gradient_pal.R
4606553c3e21e3d84d687305f41f796e *inst/examples/ex-tableau_seq_gradient_pal.R
d9f66a4f7f05ccfc167334b8ebf2f204 *inst/examples/ex-tableau_shape_pal.R
9bcab2cac8663c9e202d03404f48142c *inst/examples/ex-theme_base.R
06be20c3b39b5b3d561dd8eba3570266 *inst/examples/ex-theme_calc.R
3ade873b0052af4200cbe9030ff3df91 *inst/examples/ex-theme_clean.R
481e5524c372685f54b6f5b42592fa3a *inst/examples/ex-theme_economist.R
6bd25b7050e0bf1cf8844b3cb657d2ac *inst/examples/ex-theme_excel.R
9ce4a3ff0172cd9cb010a1abea79fd03 *inst/examples/ex-theme_excel_new.R
6b6d641d02c15fd7e12816cfb91183b8 *inst/examples/ex-theme_few.R
aa03aa46f2357ef15ac4f3916862d575 *inst/examples/ex-theme_fivethirtyeight.R
15ec52ca9064f1a111dc7657840d30cc *inst/examples/ex-theme_gdocs.R
7c78ab2047ba90701c25b218618383b6 *inst/examples/ex-theme_hc.R
0be2a546f6788c946b4cdedacf984675 *inst/examples/ex-theme_igray.R
267c50d74b54901c6bf7fbd3687e692c *inst/examples/ex-theme_map.R
3afd18d014e015a320a804a46b6f8615 *inst/examples/ex-theme_pander.R
e55e80fd4386a55ccd39bf136d862e26 *inst/examples/ex-theme_par.R
6e0fc7281aabb768f9c07d98346c70df *inst/examples/ex-theme_solarized.R
462de3721b1eb8fedb207aa1588a93bd *inst/examples/ex-theme_solid.R
583cdd4b31a079c07724cdd4569f43f9 *inst/examples/ex-theme_stata.R
54232dfa63e556e6aaee99bca6db44a4 *inst/examples/ex-theme_tufte.R
01cd6354aabdc7b20a823cbe01605850 *inst/examples/ex-theme_wsj.R
9dd2cb433da266e1e437994791cfd12e *man/bank_slopes.Rd
4665ed6b93074c33ef0c24bc3c22a510 *man/calc_pal.Rd
90d4fb232e6385e492f9787a676e67a2 *man/calc_shape_pal.Rd
a79be1e2977d646ff8025a695e2994ee *man/canva_pal.Rd
33a143c27312937cc50dbaf9750e38d3 *man/canva_palettes.Rd
029de3fcb37cc5c62d2cbc8864b8c112 *man/circlefill_shape_pal.Rd
2f23b96c01d38179da896c1e777d9052 *man/cleveland_shape_pal.Rd
c925e91cf865333ea2a610e43f06496e *man/colorblind.Rd
77bf3324885a7eb667842738543a19c6 *man/economist_pal.Rd
adf94a2243ba293d6b04d759ee4c988f *man/excel_new_pal.Rd
d82f2a1e69c1edf414358ddf0b510a0c *man/excel_pal.Rd
2fd73a9d05d2f7ff369ad9c9dc8b9ed2 *man/few_pal.Rd
60ec6986bca1c54772229e5f31ae504e *man/few_shape_pal.Rd
4405eac54eb28def08cf82fe627aa436 *man/figures/README-scale_color_tableau-1.png
ddb7057bd9d7f37fd9e280744a46ade1 *man/figures/README-scale_colorblind-1.png
d01365209bfcd58acb2bcac6ba96439f *man/figures/README-theme_calc-1.png
2513b640dc72e45ff994ee6dd15f41ea *man/figures/README-theme_clean-1.png
413df81930b2ebf820b23ffc0986112a *man/figures/README-theme_economist-1.png
a3215581797079f7c8870100441806a0 *man/figures/README-theme_excel-1.png
a8f2d031d950e30fb96a257521b047b3 *man/figures/README-theme_excel_new-1.png
ec463be8bc9a69454e2eb03ef190d88f *man/figures/README-theme_few-1.png
b1cefe5e65b93e9fc2544da646075ab0 *man/figures/README-theme_fivethirtyeight-1.png
3856e685c159004b55d2cddbe9df5051 *man/figures/README-theme_igray-1.png
ce0358c1cc9fb9a0c4d90dfee0c4d368 *man/figures/README-theme_par-1.png
489e11598666338a9fc7c61fa7a3121b *man/figures/README-theme_solarized-1.png
7c9912098f8cf9237cfea5399cabbefd *man/figures/README-theme_solarized_dark-1.png
fc481b034d247420b9005a1aed71d4af *man/figures/README-theme_solid-1.png
8e62b8514f7343b750aaa4d12514ba13 *man/figures/README-theme_stata-1.png
fb9447badcd18b0ffb4ea17d4dfc6009 *man/figures/README-theme_wsj-1.png
db2ec1462e0af723999952c03256d4b0 *man/fivethirtyeight_pal.Rd
966208907e3036e8b41f7f5bc667de94 *man/gdocs_pal.Rd
86d0a19b2e30985d91695339efaceb72 *man/geom_rangeframe.Rd
572a9764408222232e8e1192d56d5865 *man/geom_tufteboxplot.Rd
48083116eef3689d95acd90140e34286 *man/ggthemes-package.Rd
3f3add9a59bd391152ccd6ae85513407 *man/ggthemes_data.Rd
013eba66323bdc765d7cf75f96739af8 *man/hc_pal.Rd
13eb7ead192e3cd93e0f852c377422af *man/macros/funclink.Rd
347f4d4ddfc92021c3b845b375bb35cd *man/palette_pander.Rd
86099ec3adad7da0e2feb8d63e7122da *man/ptol_pal.Rd
c6b3023ee44fdd3c085fc65951932e91 *man/range_breaks.Rd
27f1ac164dff0b55bc5b53ae6ac5723c *man/scale_calc.Rd
02acea50a976953faa04b55217e971b4 *man/scale_color_tableau.Rd
040c37e919de6be0188997850f64568d *man/scale_colour_canva.Rd
b5b13a2aef6c117dff666b99c6f0d0a7 *man/scale_colour_gradient2_tableau.Rd
daf8989b701860b4783313760ae2c76a *man/scale_colour_gradient_tableau.Rd
c8f55aa44fc74dfeee2aaaf9baebe445 *man/scale_economist.Rd
4a91ef962dbcc5eebcdb9a4b12dc3eba *man/scale_excel.Rd
c6885d0ea0acebd483629b6f61945bcd *man/scale_excel_new.Rd
a0330c1cbecb98e77684ae8652386465 *man/scale_few.Rd
4ada8bc1a0606da00f8d6fc928fb97c2 *man/scale_fivethirtyeight.Rd
9d089e7bf3e7ec99277e88a3d780898c *man/scale_gdocs.Rd
83fa77b2287f4546782b51eebb9f19e0 *man/scale_hc.Rd
e5f3fefa1a4651aea5170124ae5aeffb *man/scale_linetype_stata.Rd
e8be3cbabf5d0495a4d348ffb55bbe0c *man/scale_pander.Rd
031eb76b4a80ea5f7f55a4de46220852 *man/scale_ptol.Rd
f3883a782bc1590317431e76fbceeb82 *man/scale_shape_calc.Rd
b8c487473555548238885ce30dc23fa6 *man/scale_shape_circlefill.Rd
84dbc1d897eb7c58539d90120ecdcb5c *man/scale_shape_cleveland.Rd
a76894abc7faa02cce3cce483c58677c *man/scale_shape_few.Rd
b2d062b1841ecc33e55ef4262f1b98e5 *man/scale_shape_stata.Rd
31d2a12cbff4da4226c61b720d2203bc *man/scale_shape_tableau.Rd
2ffda2a1e69c199f779e91a3eb0bb3cd *man/scale_shape_tremmel.Rd
b8db1d5a23d47eac5fcc9246a1ba0e7c *man/scale_solarized.Rd
1c5002791b02a27fb881f501be8960e6 *man/scale_stata.Rd
d74565492ab896900751a6bb908eabf9 *man/scale_wsj.Rd
8f9069298329562e94c1bae6bdd64eba *man/show_linetypes.Rd
1693af21e63e3cff1b1fad2a5476de96 *man/show_shapes.Rd
3d0300f50600ec732ba2c18b94239b0b *man/smart_digits.Rd
d33399382841aa5af8921a345e372a41 *man/solarized_pal.Rd
0461d57ce0b53527edc7df5589f2b80a *man/solarized_rebase.Rd
b32e6e6f48497e26c757fe993456a5fc *man/stat_fivenumber.Rd
4e481cc395024ec2950a8007663dcaeb *man/stata_linetype_pal.Rd
b7f5e86788895fcae0bfac81a357bb46 *man/stata_pal.Rd
7502b35031401389a5e9da0b31c134f6 *man/stata_shape_pal.Rd
d835081aac7ed7c4ed48f122104ef942 *man/tableau_color_pal.Rd
3d2eae7c89d1de13087b5c142ec8af20 *man/tableau_gradient_pal.Rd
e692c711ef3af89b476a1cc1c12d3dfd *man/tableau_shape_pal.Rd
16873dcbec455739e11af35fdd7f150f *man/theme_base.Rd
2f8aa087d58db7554510247a00be6334 *man/theme_calc.Rd
0d28040934ca95411b23aea586a61e4d *man/theme_clean.Rd
06e71d7a47bb7d5a398957f625dd45f1 *man/theme_economist.Rd
9003c90e2d80aec0c9aab0ac1284f5b1 *man/theme_excel.Rd
a1fb6207e6df5afbdd129296982be77f *man/theme_excel_new.Rd
7e058a7109f02d5f8ad1d8694f7eb84c *man/theme_few.Rd
44a523c058911c2dcd84e11a2b344cff *man/theme_fivethirtyeight.Rd
9d31458efaa17fed661a55c5f2c9483a *man/theme_foundation.Rd
cbdfab37e751195aaada5daa6a0913a4 *man/theme_gdocs.Rd
a62af3cd5e7bd475c45de75856ca6fd5 *man/theme_hc.Rd
2ea6bea49a081970e0ac61e843ad1992 *man/theme_igray.Rd
12fef5ed9094499634c7e04b52faf8c6 *man/theme_map.Rd
0b88d1f09d93819657f6d50890bf5ad8 *man/theme_pander.Rd
1dd3da786a5bd96ff289ee3e6e0278b5 *man/theme_par.Rd
58e41b367fcad485420a4e6aa60ee27f *man/theme_solarized.Rd
465a99e28178fe2b78beb5dd223cb40a *man/theme_solid.Rd
4f70b21486f9346934b16aa43d08532c *man/theme_stata.Rd
2c732ee117069020d6cae5aa717903a3 *man/theme_tufte.Rd
333ada3bf06c27a80593d710b84713e1 *man/theme_wsj.Rd
da8c654244e381a5f2d4dbd352a7e7f5 *man/tremmel_shape_pal.Rd
e984e0b10c8518a5b56f0af02c0aac79 *man/wsj_pal.Rd
b0ab17eb094c0a55dc40999f1f0c666a *tests/figs/deps.txt
1638d9c9f506b9751d57a6602061eacc *tests/figs/few/theme-few.svg
6286c40603df000aaae222467ae8cd76 *tests/spelling.R
c908b4274b1f5d2f7de933100504e3fa *tests/testthat.R
437d31c764eba376e2f277add7235f40 *tests/testthat/_snaps/few/theme-few.svg
d3707b7d1498a0f2bd9423a5a319ccce *tests/testthat/_snaps/shapes.md
d7904b65cff976255116a1014f0ffecb *tests/testthat/helper-utils.R
59b196c4b04ff45aaa54bd92c5eee473 *tests/testthat/helper-vdiffr.R
03aeb864c28e5a5359c2297e23325692 *tests/testthat/test-banking.R
037331b60010c5104252559bd5a3fd09 *tests/testthat/test-base.R
feadec5327804ddbfcd5719fb93c31c1 *tests/testthat/test-calc.R
30e05b1cadedd650a72b88bb0a8b925d *tests/testthat/test-canva.R
138f965c5424f9c3521aed8db89bef19 *tests/testthat/test-colorblind.R
465ba8f5809b1dab2a97c7f56039debe *tests/testthat/test-economist.R
5bbe302de95b957f1131e4ad80af435e *tests/testthat/test-excel.R
a9a9ecb24c382d46604d4cb5600d38df *tests/testthat/test-few.R
41583f883ee87ba98b3a474b1d20c43a *tests/testthat/test-fivethirtyeight.R
8e4813a69f879b08d5038a1147aad741 *tests/testthat/test-gdocs.R
3a58f3ed0c78649f2609a69d38d772f0 *tests/testthat/test-geom-rangeframe.R
77da46e538329d77364e221e441b04c5 *tests/testthat/test-hc.R
a7858ec0154be4dcff3bf3151102e2b1 *tests/testthat/test-igray.R
be1309314f643952fae48a19d440e807 *tests/testthat/test-pander.R
0d9e5dc7b3f0e9a965bc12e38bbc0c41 *tests/testthat/test-ptol.R
6edceb6ea62ec68910c97483b1167fb9 *tests/testthat/test-shapes.R
29ffe7411e6c9a7e422b1fa7e84b83a3 *tests/testthat/test-show.R
0e9ca3f149df289210b654164d405b0f *tests/testthat/test-solarized.R
316d10249af4e34406044c3c84b2f84e *tests/testthat/test-stat_fivenumber.R
4e1dbd92e3fec17e15b3f32c97c91891 *tests/testthat/test-stata.R
bd841ecad79ba0565e9a83ff88bbe913 *tests/testthat/test-tableau.R
ba7dff72d36f2f11ebe866c01977dbf4 *tests/testthat/test-theme_map.R
c87a24c24dd2b7637e6a241e5c18c572 *tests/testthat/test-theme_solid.R
17ce06aea7f53cd59e9e331d38ad3bb3 *tests/testthat/test-tufte.R
2f67253a6e0e972dc91ec8bc97972b81 *tests/testthat/test-tufteboxplot.R
155dff9726d756f4ca62df7de6b07484 *tests/testthat/test-wsj_pal.R
ggthemes/R/ 0000755 0001762 0000144 00000000000 15112676746 012275 5 ustar ligges users ggthemes/R/show.R 0000644 0001762 0000144 00000003714 15112461554 013372 0 ustar ligges users #' Show shapes
#'
#' A quick and dirty way to show shapes.
#'
#' @export
#' @param shapes A numeric or character vector of shapes. See
#' \code{\link[graphics]{par}()}.
#' @param labels Include the plotting character value of the symbol.
#' @seealso \code{\link[scales]{show_col}()}, \code{\link{show_linetypes}()}
#' @return This function called for the side effect of creating a plot.
#' It returns \code{shapes}.
#' @example inst/examples/ex-show_shapes.R
show_shapes <- function(shapes, labels = TRUE) {
n <- length(shapes)
ncol <- ceiling(sqrt(n))
nrow <- ceiling(n / ncol)
x <- c(shapes, rep(NA, nrow * ncol - length(shapes)))
x <- matrix(x, ncol = ncol, byrow = TRUE)
x <- x[rev(seq_len(nrow(x))), ]
plot(0, 0, xlim = c(1, ncol(x)), ylim = c(1, nrow(x)), type = "n", xlab = "", ylab = "", axes = FALSE)
for (i in seq_len(ncol(x))) {
for (j in seq_len(nrow(x))) {
points(i, j, pch = x[j, i])
if (labels) {
text(i, j, x[j, i], pos = 1, col = "gray70")
}
}
}
invisible(shapes)
}
#' Show linetypes
#'
#' A quick and dirty way to show linetypes.
#'
#' @export
#' @param linetypes A character vector of linetypes. See
#' \code{\link{par}()}.
#' @param labels Label each line with its linetype (lty) value.
#'
#' @seealso \code{\link[scales]{show_col}()}, \code{\link{show_linetypes}()}
#'
#' @example inst/examples/ex-show_linetypes.R
#' @return This function called for the side effect of creating a plot.
#' It returns \code{linetypes}.
#' @importFrom graphics plot
show_linetypes <- function(linetypes, labels = TRUE) {
n <- length(linetypes)
plot(0, 0, xlim = c(0, 1), ylim = c(n, 1), type = "n", xlab = "", ylab = "", axes = FALSE)
for (i in seq_along(linetypes)) {
abline(h = i, lty = linetypes[i])
}
if (labels) {
axis(side = 2, at = seq_len(n), tick = FALSE, labels = linetypes, las = 2)
} else {
axis(side = 2, at = seq_len(n), tick = FALSE, labels = seq_len(n), las = 2)
}
invisible(linetypes)
}
ggthemes/R/hc.R 0000644 0001762 0000144 00000006064 15112654506 013006 0 ustar ligges users #' Highcharts Theme
#'
#' Theme based on \href{https://www.highcharts.com/}{Highcharts} plots.
#'
#' @references
#'
#' \url{https://www.highcharts.com/demo/highcharts/line-chart}
#'
#' @inheritParams ggplot2::theme_bw
#' @param style The Highcharts theme to use \code{'default'},
#' \code{'darkunica'}.
#' @param bgcolor Deprecated
#' @example inst/examples/ex-theme_hc.R
#' @family themes hc
#' @export
theme_hc <- function(base_size = 12, base_family = "sans", style = c("default", "darkunica"), bgcolor = NULL) {
if (!is.null(bgcolor)) {
warning("`bgcolor` is deprecated. Use `style` instead.")
style <- bgcolor
}
style <- match.arg(style)
bgcolor <- switch(style, default = "#FFFFFF", "darkunica" = "#2a2a2b")
ret <- theme(
rect = element_rect(fill = bgcolor, linetype = 0, colour = NA),
text = element_text(size = base_size, family = base_family),
title = element_text(hjust = 0.5),
axis.title.x = element_text(hjust = 0.5),
axis.title.y = element_text(hjust = 0.5),
panel.grid.major.y = element_line(colour = "#D8D8D8"),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
legend.position = "bottom",
legend.key = element_rect(fill = "#FFFFFF00")
)
if (style == "darkunica") {
ret <- (ret +
theme(
rect = element_rect(fill = bgcolor),
text = element_text(colour = "#A0A0A3"),
title = element_text(colour = "#FFFFFF"),
axis.title.x = element_text(colour = "#A0A0A3"),
axis.title.y = element_text(colour = "#A0A0A3"),
panel.grid.major.y = element_line(colour = "#707073"),
legend.title = element_text(colour = "#A0A0A3")
))
}
ret
}
#' Highcharts color palette (discrete)
#'
#' The Highcharts uses many different color palettes in its
#' plots. This collects a few of them.
#'
#' @param palette \code{character} The name of the Highcharts theme to use. One of
#' \code{"default"}, or \code{"darkunica"}.
#'
#' @family colour hc
#' @export
hc_pal <- function(palette = "default") {
if (palette %in% names(ggthemes::ggthemes_data$hc)) {
manual_pal(unname(ggthemes::ggthemes_data$hc[[palette]]))
} else {
stop(
"Palette `",
palette,
"` not valid. Must be one of ",
stringr::str_c("`", names(ggthemes::ggthemes_data$hc), "`", collapse = ", "),
call. = FALSE
)
}
}
#' Highcharts color and fill scales
#'
#' Colour and fill scales which use the palettes in
#' \code{\link{hc_pal}()} and are meant for use with
#' \code{\link{theme_hc}()}.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @inheritParams hc_pal
#' @family colour hc
#' @rdname scale_hc
#' @export
scale_colour_hc <- function(palette = "default", ...) {
discrete_scale("colour", palette = hc_pal(palette), ...)
}
#' @rdname scale_hc
#' @export
scale_color_hc <- scale_colour_hc
#' @rdname scale_hc
#' @export
scale_fill_hc <- function(palette = "default", ...) {
discrete_scale("fill", palette = hc_pal(palette), ...)
}
ggthemes/R/few.R 0000644 0001762 0000144 00000011146 15112654506 013172 0 ustar ligges users # nolint start
#' Color Palettes Few "Show Me the Numbers"
#'
#' Qualitative color palettes from Stephen Few (2012)
#' \emph{Show Me the Numbers}. There are three palettes:
#' Light, Medium, and Dark. Each palette comprises nine colors:
#' gray, blue, orange, green, pink, brown, purple, yellow, red.
#' For \code{n = 1}, gray is used. For \code{n > 1}, the eight non-gray
#' colors are used.
#'
#'
#' Use the light palette for filled areas, such as bar charts.
#' Use the medium palette for points and lines.
#' Use the dark palette for highlighting specific points
#' or for small and thin lines and points.
#'
#' @references
#' Few, S. (2012) \emph{Show Me the Numbers: Designing Tables and Graphs to Enlighten}.
#' 2nd edition. Analytics Press.
#'
#' \href{https://www.perceptualedge.com/articles/visual_business_intelligence/rules_for_using_color.pdf}{"Practical Rules for Using Color in Charts"}.
#'
#' @export
#' @param palette One of \Sexpr[results=rd]{names(ggthemes:::rd_optlist(ggthemes::ggthemes_data$few$colors))}
#' @family colour few
#' @example inst/examples/ex-few_pal.R
# nolint end
few_pal <- function(palette = "Medium") {
palette <- ggthemes::ggthemes_data$few$colors[[palette]]
if (is.null(palette)) {
stop(
"palette must be one of: ",
paste0("\"", names(ggthemes::ggthemes_data$few$colors), "\"", collapse = ", "),
call. = FALSE
)
}
## The first value, gray, is used for non-data parts.
values <- palette[["value"]]
max_n <- length(values) - 1L
f <- function(n) {
check_pal_n(n, max_n)
if (n == 1L) {
values[[1L]]
} else {
unname(values[2L:(n + 1L)])
}
}
attr(f, "max_n") <- length(values) - 1L
f
}
#' Color scales from Few's "Practical Rules for Using Color in Charts"
#'
#' See \code{\link{few_pal}()}.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @inheritParams few_pal
#' @family colour few
#' @rdname scale_few
#' @export
scale_colour_few <- function(palette = "Medium", ...) {
discrete_scale("colour", palette = few_pal(palette), ...)
}
#' @export
#' @rdname scale_few
scale_color_few <- scale_colour_few
#' @export
#' @rdname scale_few
scale_fill_few <- function(palette = "Light", ...) {
discrete_scale("fill", palette = few_pal(palette), ...)
}
#' Theme based on Few's "Practical Rules for Using Color in Charts"
#'
#' Theme based on the rules and examples from Stephen Few's
#' \emph{Show Me the Numbers} and "Practical Rules for Using Color in Charts".
#'
#' @references
#' Few, S. (2012) \emph{Show Me the Numbers: Designing Tables and Graphs to Enlighten}.
#' 2nd edition. Analytics Press.
#'
#' Stephen Few, "Practical Rules for Using Color in Charts",
#' \url{https://www.perceptualedge.com/articles/visual_business_intelligence/rules_for_using_color.pdf}.
#'
#' @inheritParams ggplot2::theme_bw
#' @family themes few
#' @export
#' @example inst/examples/ex-theme_few.R
theme_few <- function(base_size = 12, base_family = "") {
gray <- "#4D4D4D"
black <- "#000000"
theme_bw(base_size = base_size, base_family = base_family) +
theme(
line = element_line(colour = gray),
rect = element_rect(fill = "white", colour = NA),
text = element_text(colour = black),
axis.ticks = element_line(colour = gray),
legend.key = element_rect(colour = NA),
## Examples do not use grid lines
panel.border = element_rect(colour = gray),
panel.grid = element_blank(),
strip.background = element_rect(fill = "white", colour = NA)
)
}
#' Shape palette from "Show Me the Numbers" (discrete)
#'
#' Shape palette from Stephen Few's, "Show Me the Numbers".
#' The shape palette consists of five shapes: circle, square, triangle, plus,
#' times.
#'
#' @references Few, S. (2012)
#' \emph{Show Me the Numbers: Designing Tables and Graphs to Enlighten},
#' Analytics Press, p. 208.
#'
#' @export
few_shape_pal <- function() {
shapes <- ggthemes::ggthemes_data[["few"]][["shapes"]]
max_n <- nrow(shapes)
f <- function(n) {
check_pal_n(n, max_n)
shapes[["pch"]][seq_len(n)]
}
attr(f, "max_n") <- max_n
f
}
#' Scales for shapes from "Show Me the Numbers"
#'
#' \code{scale_shape_few()} maps discrete variables to up to five easily
#' discernible shapes. It is based on the shape palette suggested in
#' Few (2012).
#'
#' @param ... Common \code{\link[ggplot2]{discrete_scale}()} parameters.
#' @references Few, S. (2012)
#' \emph{Show Me the Numbers: Designing Tables and Graphs to Enlighten},
#' Analytics Press, p. 208.
#' @seealso \code{\link{scale_shape_few}()} for the shape palette that this
#' scale uses.
#' @export
scale_shape_few <- function(...) {
discrete_scale("shape", palette = few_shape_pal(), ...)
}
ggthemes/R/igray.R 0000644 0001762 0000144 00000002277 15112366564 013535 0 ustar ligges users #' Inverse gray theme
#'
#' Theme with white panel and gray background.
#'
#' @section Details:
#'
#' This theme inverts the colors in the \code{\link[ggplot2]{theme_gray}()}, a
#' white panel and a light gray area around it. This keeps a white
#' background for the color scales like \code{\link[ggplot2]{theme_bw}()}. But
#' by using a gray background, the plot is closer to the
#' typographical color of the document, which is the motivation for
#' using a gray panel in \code{\link[ggplot2]{theme_gray}()}. This is
#' similar to the style of plots in Stata and Tableau.
#'
#' @inheritParams ggplot2::theme_grey
#' @export
#' @family themes
#' @seealso \code{\link[ggplot2]{theme_gray}()},
#' \code{\link[ggplot2]{theme_bw}()}
#' @example inst/examples/ex-theme_igray.R
#' @importFrom ggplot2 theme_gray
theme_igray <- function(base_size = 12, base_family = "") {
(theme_gray(base_size = base_size, base_family = base_family) +
theme(
rect = element_rect(fill = "gray90"),
legend.key = element_rect(fill = "white"),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_line(colour = "gray90"),
plot.background = element_rect(fill = "gray90")
))
}
ggthemes/R/ptol.R 0000644 0001762 0000144 00000002601 15112711443 013355 0 ustar ligges users #' Color Palettes from Paul Tol's "Colour Schemes"
#'
#' Qualitative color palettes from Paul Tol,
#' \href{https://sronpersonalpages.nl/~pault/}{"Colour Schemes"}.
#'
#' Incorporation of the palette into an R package was originally inspired by
#' Peter Carl's [Paul Tol 21 Gun Salute](https://tradeblotter.wordpress.com/2013/02/28/the-paul-tol-21-color-salute/)
#'
#' @export
#' @family colour ptol
#' @references
#' Paul Tol. 2012. "Colour Schemes." SRON Technical Note, SRON/EPS/TN/09-002.
#' \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-ptol_pal.R
ptol_pal <- function() {
colors <- ggthemes::ggthemes_data[["ptol"]][["qualitative"]]
max_n <- length(colors)
f <- function(n) {
check_pal_n(n, max_n)
colors[[n]]
}
attr(f, "max_n") <- max_n
f
}
#' Color Scales from Paul Tol's "Colour Schemes
#'
#' See \code{\link{ptol_pal}()}. These palettes support up to 12 values.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @inheritParams ptol_pal
#' @family colour ptol
#' @rdname scale_ptol
#' @export
#' @example inst/examples/ex-scale_colour_ptol.R
scale_colour_ptol <- function(...) {
discrete_scale("colour", palette = ptol_pal(), ...)
}
#' @export
#' @rdname scale_ptol
scale_color_ptol <- scale_colour_ptol
#' @export
#' @rdname scale_ptol
scale_fill_ptol <- function(...) {
discrete_scale("fill", palette = ptol_pal(), ...)
}
ggthemes/R/wsj.R 0000644 0001762 0000144 00000010003 15112711261 013173 0 ustar ligges users #' Wall Street Journal theme
#'
#' Theme based on the plots in \emph{The Wall Street Journal}.
#'
#' This theme should be used with \code{\link{scale_color_wsj}()}.
#'
#' @references
#'
#' \url{https://x.com/WSJGraphics}
#'
#' \url{https://pinterest.com/wsjgraphics/wsj-graphics/}
#'
#' @inheritParams ggplot2::theme_grey
#' @param color The background color of plot. One of \code{'brown',
#' 'gray', 'green', 'blue'}.
#' @param title_family Plot title font family.
#' @family themes wsj
#' @example inst/examples/ex-theme_wsj.R
#' @export
#' @importFrom ggplot2 element_line element_rect element_text element_blank rel
theme_wsj <- function(base_size = 12, color = "brown", base_family = "sans", title_family = "mono") {
colorhex <- ggthemes::ggthemes_data$wsj$bg[color]
theme_foundation(base_size = base_size, base_family = base_family) +
theme(
line = element_line(linetype = 1, colour = "black"),
rect = element_rect(fill = colorhex, linetype = 0, colour = NA),
text = element_text(colour = "black"),
title = element_text(
family = title_family,
size = rel(2)
),
axis.title = element_blank(),
axis.text = element_text(face = "bold", size = rel(1)),
axis.text.x = element_text(colour = NULL),
axis.text.y = element_text(colour = NULL),
axis.ticks = element_line(colour = NULL),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(colour = NULL),
axis.line = element_line(),
axis.line.y = element_blank(),
legend.background = element_rect(),
legend.position = "top",
legend.direction = "horizontal",
legend.box = "vertical",
panel.grid = element_line(colour = NULL, linetype = 3),
panel.grid.major = element_line(colour = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0, face = "bold"),
plot.margin = unit(c(1, 1, 1, 1), "lines"),
strip.background = element_rect()
)
}
#' Wall Street Journal color palette (discrete)
#'
#' The Wall Street Journal uses many different color palettes in its
#' plots. This collects a few of them, but is by no means exhaustive.
#' Collections of these plots can be found on the WSJ Graphics
#' \href{https://x.com/WSJGraphics}{X (formerly Twitter)} feed and
#' \href{https://pinterest.com/wsjgraphics/wsj-graphics/}{Pinterest}.
#'
#' @section Palettes:
#'
#' The following palettes are defined,
#'
#' \describe{
#' \item{rgby}{Red/Green/Blue/Yellow theme.}
#' \item{red_green}{Green/red two-color scale for good/bad.}
#' \item{green_black}{Black-green 4-color scale for 'Very negative',
#' 'Somewhat negative', 'somewhat positive', 'very positive'.}
#' \item{dem_rep}{Democrat/Republican/Undecided blue/red/gray scale.}
#' \item{colors6}{Red, blue, gold, green, orange, and black palette.}
#' }
#'
#' @param palette \code{character} The color palette to use: .
#' \Sexpr[results=rd]{ggthemes:::rd_optlist(names(ggthemes::ggthemes_data$wsj$palettes))}
#'
#' @family colour wsj
#' @export
wsj_pal <- function(palette = "colors6") {
palettes <- ggthemes::ggthemes_data[["wsj"]][["palettes"]]
if (palette %in% names(palettes)) {
colors <- palettes[[palette]][["value"]]
max_n <- length(colors)
f <- manual_pal(unname(colors))
attr(f, "max_n") <- max_n
f
} else {
stop(sprintf("palette %s not a valid palette.", palette))
}
}
#' Wall Street Journal color and fill scales
#'
#' Colour and fill scales which use the palettes in \code{\link{wsj_pal}()}.
#' These scales should be used with \code{\link{theme_wsj}()}.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @inheritParams wsj_pal
#' @family colour wsj
#' @rdname scale_wsj
#' @export
scale_colour_wsj <- function(palette = "colors6", ...) {
discrete_scale("colour", palette = wsj_pal(palette), ...)
}
#' @rdname scale_wsj
#' @export
scale_color_wsj <- scale_colour_wsj
#' @rdname scale_wsj
#' @export
scale_fill_wsj <- function(palette = "colors6", ...) {
discrete_scale("fill", palette = wsj_pal(palette), ...)
}
ggthemes/R/ggthemes-package.R 0000644 0001762 0000144 00000000563 15112366564 015612 0 ustar ligges users #' @keywords internal
"_PACKAGE"
#' @importFrom ggplot2 ggplot theme ggproto aes draw_key_path
#' @importFrom grid grobTree grobName gTree gList segmentsGrob gpar
#' @importFrom scales manual_pal div_gradient_pal seq_gradient_pal
#' @importFrom graphics abline axis text points
#' @importFrom methods hasArg as
#' @importFrom graphics par
NULL
globalVariables(".data")
ggthemes/R/fivethirtyeight.R 0000644 0001762 0000144 00000004740 15112654506 015631 0 ustar ligges users #' Theme inspired by FiveThirtyEight plots
#'
#' Theme inspired by the plots from FiveThirtyEight.com.
#'
#' @inheritParams ggplot2::theme_grey
#' @family themes fivethirtyeight
#' @export
#' @example inst/examples/ex-theme_fivethirtyeight.R
#' @importFrom grid unit
theme_fivethirtyeight <- function(base_size = 12, base_family = "sans") {
colors <- deframe(ggthemes::ggthemes_data[["fivethirtyeight"]])
(theme_foundation(base_size = base_size, base_family = base_family) +
theme(
line = element_line(colour = "black"),
rect = element_rect(
fill = colors["Light Gray"],
linetype = 0,
colour = NA
),
text = element_text(colour = colors["Dark Gray"]),
axis.title = element_blank(),
axis.text = element_text(),
axis.ticks = element_blank(),
axis.line = element_blank(),
legend.background = element_rect(),
legend.position = "bottom",
legend.direction = "horizontal",
legend.box = "vertical",
panel.grid = element_line(colour = NULL),
panel.grid.major = element_line(colour = colors["Medium Gray"]),
panel.grid.minor = element_blank(),
# unfortunately, can't mimic subtitles TODO!
plot.title = element_text(hjust = 0, size = rel(1.5), face = "bold"),
plot.margin = unit(c(1, 1, 1, 1), "lines"),
strip.background = element_rect()
))
}
#' FiveThirtyEight color palette
#'
#' The standard three-color FiveThirtyEight palette for line plots comprises
#' blue, red, and green.
#'
#' @family colour fivethirtyeight
#' @export
#' @example inst/examples/ex-fivethirtyeight_pal.R
fivethirtyeight_pal <- function() {
colors <- deframe(ggthemes::ggthemes_data[["fivethirtyeight"]])
values <- unname(colors[c("Blue", "Red", "Green")])
max_n <- length(values)
f <- manual_pal(values)
attr(f, "max_n") <- max_n
f
}
#' FiveThirtyEight color scales
#'
#' Color scales using the colors in the FiveThirtyEight graphics.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @family colour fivethirtyeight
#' @rdname scale_fivethirtyeight
#' @seealso \code{\link{theme_fivethirtyeight}()} for examples.
#' @export
scale_colour_fivethirtyeight <- function(...) {
discrete_scale("colour", palette = fivethirtyeight_pal(), ...)
}
#' @rdname scale_fivethirtyeight
#' @export
scale_color_fivethirtyeight <- scale_colour_fivethirtyeight
#' @rdname scale_fivethirtyeight
#' @export
scale_fill_fivethirtyeight <- function(...) {
discrete_scale("fill", palette = fivethirtyeight_pal(), ...)
}
ggthemes/R/economist.R 0000644 0001762 0000144 00000021245 15112654506 014412 0 ustar ligges users #' Economist color palette (discrete)
#'
#' The hues in the palette are blues, grays, and greens. Red is not
#' included in these palettes and should be used to indicate
#' important data.
#'
#' @param fill Use the fill palette.
#' @family colour economist
#' @export
#' @example inst/examples/ex-economist_pal.R
economist_pal <- function(fill = TRUE) {
colors <- deframe(ggthemes::ggthemes_data[["economist"]][["fg"]])
if (fill) {
max_n <- 9
f <- function(n) {
check_pal_n(n, max_n)
if (n == 1L) {
i <- "dark blue"
} else if (n == 2L) {
i <- c("blue", "dark blue")
} else if (n == 3L) {
i <- c("blue-gray", "dark blue", "blue")
} else if (n == 4L) {
i <- c("blue-gray", "dark blue", "blue", "gray")
} else if (n %in% 5:6) {
## 20120901_woc904
i <- c(
"blue-gray",
"dark blue",
"light blue",
"blue",
"light green",
"dark green"
)
} else if (n == 7L) {
# 20120818_AMC820
i <- c(
"blue-gray",
"dark blue",
"blue",
"light blue",
"dark green",
"light green",
"gray"
)
} else if (n >= 8L) {
# 20120915_EUC094
i <- c(
"blue-gray",
"dark blue",
"blue",
"light blue",
"dark green",
"light green",
"dark red",
"pink",
"gray"
)
}
unname(colors[i][seq_len(n)])
}
} else {
max_n <- 9
f <- function(n) {
check_pal_n(n, max_n)
if (n <= 3) {
# 20120818_AMC20
# 20120901_FBC897
i <- c("dark blue", "blue", "light blue")
} else if (n %in% 4:5) {
# i <- c("dark blue", "blue", "light blue", "red", "gray")
i <- c("dark blue", "blue", "light blue", "blue-gray", "gray")
} else if (n == 6) {
# 20120825_IRC829
i <- c(
"light green",
"dark green",
"gray",
"blue-gray",
"light blue",
"dark blue"
)
} else if (n > 6) {
# 20120825_IRC829
i <- c(
"light green",
"dark green",
"gray",
"blue-gray",
"light blue",
"dark blue",
"dark red",
"pink",
"brown"
)
}
unname(colors[i][seq_len(n)])
}
}
attr(f, "max_n") <- max_n
f
}
#' Economist color scales
#'
#' Color scales using the colors in the Economist graphics.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @inheritParams economist_pal
#' @family colour economist
#' @rdname scale_economist
#' @seealso \code{\link{theme_economist}()} for examples.
#' @export
scale_colour_economist <- function(...) {
discrete_scale("colour", palette = economist_pal(), ...)
}
#' @rdname scale_economist
#' @export
scale_color_economist <- scale_colour_economist
#' @rdname scale_economist
#' @export
scale_fill_economist <- function(...) {
discrete_scale("fill", palette = economist_pal(), ...)
}
#' ggplot color theme based on the Economist
#'
#' A theme that approximates the style of \emph{The Economist}.
#'
#' \code{theme_economist} implements the standard bluish-gray
#' background theme in the print \emph{The Economist} and
#' \href{https://www.economist.com/}{economist.com}.
#'
#' \code{theme_economist_white} implements a variant with a while
#' panel and light gray (or white) background often used by \emph{The Economist}
#' blog \href{https://www.economist.com/blogs/graphicdetail}{Graphic Detail}.
#'
#' Use \code{\link{scale_color_economist}()} with this theme.
#' The x axis should be displayed on the right hand side.
#'
#' \emph{The Economist} uses "ITC Officina Sans" as its font for graphs. If
#' you have access to this font, you can use it with the
#' \pkg{extrafont} package. "Verdana" is a good substitute.
#'
#' @inheritParams ggplot2::theme_grey
#' @param horizontal \code{logical} Horizontal axis lines?
#' @param dkpanel \code{logical} Darker background for panel region?
#' @param gray_bg \code{logical} If \code{TRUE}, use gray background, else
#' use white
#' background.
#'
#' @return An object of class \code{\link[ggplot2]{theme}()}.
#'
#' @export
#' @family themes economist
#'
#' @references
#' \itemize{
#' \item \href{https://www.economist.com/}{The Economist}
#' \item \href{https://spiekermann.com/en/itc-officina-display/}{Spiekerblog, "ITC Officina Display", January 1, 2007.}
#' }
#'
#' @example inst/examples/ex-theme_economist.R
theme_economist <- function(base_size = 10, base_family = "sans", horizontal = TRUE, dkpanel = FALSE) {
bgcolors <- deframe(ggthemes::ggthemes_data[["economist"]][["bg"]])
## From measurements
## Ticks = 1 / 32 in, with margin about 1.5 / 32
## Title = 3 / 32 in (6 pt)
## Legend Labels = 2.5 / 32 in (5pt)
## Axis Labels = 2
## Axis Titles and other text ~ 2
## Margins: Top / Bottom = 6 / 32, sides = 5 / 32
ret <-
theme_foundation(base_size = base_size, base_family = base_family) +
theme(
line = element_line(colour = "black"),
rect = element_rect(
fill = bgcolors["ebg"],
colour = NA,
linetype = 1
),
text = element_text(colour = "black"),
## Axis
axis.line = element_line(linewidth = rel(0.8)),
axis.line.y = element_blank(),
axis.text = element_text(size = rel(1)),
axis.text.x = element_text(
vjust = 0,
margin = margin(
t = base_size,
unit = "pt"
)
),
axis.text.x.top = element_text(vjust = 0, margin = margin(b = base_size, unit = "pt")),
axis.text.y = element_text(
hjust = 0,
margin = margin(
r = base_size,
unit = "pt"
)
),
## I cannot figure out how to get ggplot to do 2 levels of ticks
## axis.ticks.margin = unit(3 / 72, "in"),
axis.ticks = element_line(),
axis.ticks.y = element_blank(),
axis.title = element_text(size = rel(1)),
axis.title.x = element_text(),
axis.title.y = element_text(angle = 90),
# axis.ticks.length = unit( -1/32, "in"),
axis.ticks.length = unit(-base_size * 0.5, "points"),
legend.background = element_rect(linetype = 0),
legend.spacing = unit(base_size * 1.5, "points"),
legend.key = element_rect(linetype = 0),
legend.key.size = unit(1.2, "lines"),
legend.key.height = NULL,
legend.key.width = NULL,
legend.text = element_text(size = rel(1.25)),
legend.title = element_text(size = rel(1), hjust = 0),
legend.position = "top",
legend.direction = NULL,
legend.justification = "center",
## legend.box = element_rect(fill = palette_economist['bgdk'],
## colour=NA, linetype=0),
## Economist only uses vertical lines
panel.background = element_rect(linetype = 0),
panel.border = element_blank(),
panel.grid.major = element_line(colour = "white", linewidth = rel(1.75)),
panel.grid.minor = element_blank(),
panel.spacing = unit(0.25, "lines"),
strip.background = element_rect(
fill = bgcolors["ebg"],
colour = NA,
linetype = 0
),
strip.text = element_text(size = rel(1.25)),
strip.text.x = element_text(),
strip.text.y = element_text(angle = -90),
plot.background = element_rect(
fill = bgcolors["blue-gray"],
colour = NA
),
plot.title = element_text(
size = rel(1.5),
hjust = 0,
face = "bold"
),
plot.margin = unit(c(6, 5, 6, 5) * 2, "points"),
complete = TRUE
)
if (horizontal) {
ret <- ret + theme(panel.grid.major.x = element_blank())
} else {
ret <- ret + theme(panel.grid.major.y = element_blank())
}
if (dkpanel == TRUE) {
ret <- ret +
theme(
panel.background = element_rect(
fill = unname(bgcolors["dark blue-gray"])
),
strip.background = element_rect(
fill = unname(bgcolors["dark blue-gray"])
)
)
}
ret
}
#' @rdname theme_economist
#' @export
theme_economist_white <- function(base_size = 11, base_family = "sans", gray_bg = TRUE, horizontal = TRUE) {
if (gray_bg) {
bgcolor <- get_colors(c("economist", "bg"), "light gray")
} else {
bgcolor <- "white"
}
theme_economist(
base_family = base_family,
base_size = base_size,
horizontal = horizontal
) +
theme(
rect = element_rect(fill = bgcolor),
plot.background = element_rect(fill = bgcolor),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_line(
colour = get_colors(c("economist", "bg"), "dark gray")
),
strip.background = element_rect(fill = "white")
)
}
ggthemes/R/geom-tufteboxplot.R 0000644 0001762 0000144 00000020324 15112461554 016072 0 ustar ligges users #' Tufte's Box Plot
#'
#' Edward Tufte's revisions of the box plot as described in
#' \emph{The Visual Display of Quantitative Information}.
#' This functions provides several box plot variants:
#' \itemize{
#' \item{A point indicating the median, a gap indicating the
#' interquartile range, and lines for whiskers.}
#' \item{An offset line indicating the interquartile range
#' and a gap indicating the median.}
#' \item{A line indicating the interquartile range,
#' a gap indicating the median, and points indicating
#' the minimum and maximum values}
#' \item{A wide line indicating the interquartile range,
#' a gap indicating the median, and lines indicating the minimum and
#' maximum.}
#' }
#'
#' @section Aesthetics:
#' \itemize{
#' \item x [required]
#' \item y [required]
#' \item colour
#' \item size
#' \item linetype
#' \item shape
#' \item fill
#' \item alpha
#' }
#'
#' @references Tufte, Edward R. (2001) The Visual Display of
#' Quantitative Information, Chapter 6.
#'
#' McGill, R., Tukey, J. W. and Larsen, W. A. (1978) Variations of
#' box plots. The American Statistician 32, 12-16.
#'
#' @seealso \code{\link[ggplot2]{geom_boxplot}()}
#' @inheritParams ggplot2::geom_point
#' @param outlier.colour colour for outlying points
#' @param outlier.shape shape of outlying points
#' @param outlier.size size of outlying points
#' @param outlier.stroke stroke for outlying points
#' @param median.type If \code{'point'}, then the median is represented by a
#' point, and the interquartile range by a gap in the line. If
#' \code{median.type='line'}, then the interquartile range is represented by
#' a line, possibly offset, and the median by a gap in the line.
#' @param whisker.type If \code{'line'}, then whiskers are represented by lines.
#' If \code{'point'}, then whiskers are represented by points at
#' \code{ymin} and \code{ymax}.
#' @param voffset controls the size of the gap in the line representing the
#' median when \code{median.type = 'line'}. This is a fraction of the range
#' of \code{y}.
#' @param hoffset controls how much the interquartile line is offset from the
#' whiskers when \code{median.type = 'line'}. This is a fraction of the
#' range of \code{x}.
#' @param stat The statistical transformation to use on the data for this
#' layer, as a string. The default (\code{stat = 'fivenumber'}) calls
#' \code{\link{stat_fivenumber}} and produces whiskers that extend
#' from the interquartile range to the extremes of the data; specifying
#' \code{\link[ggplot2]{stat_boxplot}} will produce a more traditional boxplot
#' with whiskers extending to the most extreme points that are < 1.5 IQR
#' away from the hinges (i.e., the first and third quartiles).
#' @family geom tufte
#' @export
#'
#' @example inst/examples/ex-geom_tufteboxplot.R
geom_tufteboxplot <-
function(
mapping = NULL,
data = NULL,
stat = "fivenumber",
position = "dodge",
outlier.colour = "black", # nolint: object_name_linter
outlier.shape = 19, # nolint: object_name_linter
outlier.size = 1.5, # nolint: object_name_linter
outlier.stroke = 0.5, # nolint: object_name_linter
voffset = 0.01,
hoffset = 0.005,
na.rm = FALSE, # nolint: object_name_linter
show.legend = NA, # nolint: object_name_linter
inherit.aes = TRUE, # nolint: object_name_linter
median.type = "point", # nolint: object_name_linter
whisker.type = "line", # nolint: object_name_linter
...
) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomTufteboxplot,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
outlier.colour = outlier.colour,
outlier.shape = outlier.shape,
outlier.size = outlier.size,
outlier.stroke = outlier.stroke,
voffset = voffset,
hoffset = hoffset,
median.type = median.type,
whisker.type = whisker.type,
na.rm = na.rm,
...
)
)
}
#' @rdname geom_tufteboxplot
#' @usage NULL
#' @format NULL
#' @export
#' @importFrom ggplot2 draw_key_pointrange ggproto_parent GeomBoxplot GeomSegment GeomPoint
#' @importFrom scales alpha
#' @importFrom grid grobTree
GeomTufteboxplot <- # nolint: object_name_linter
ggplot2::ggproto(
"GeomTufteboxplot",
ggplot2::GeomBoxplot,
setup_data = function(self, data, params) {
data <- ggproto_parent(GeomBoxplot, self)$setup_data(data, params)
x_range <- diff(range(data$x))
y_range <- max(data$ymax) - min(data$ymin)
data$hoffset <- params$hoffset * x_range
data$voffset <- params$voffset * y_range
data
},
draw_group = function(
data,
panel_scales,
coord,
fatten = 2,
outlier.colour = "black", # nolint: object_name_linter
outlier.shape = 19, # nolint: object_name_linter
outlier.size = 1.5, # nolint: object_name_linter
outlier.stroke = 0.5, # nolint: object_name_linter
varwidth = FALSE,
median.type = c("point", "line"), # nolint: object_name_linter
whisker.type = c("line", "point"), # nolint: object_name_linter
hoffset = 0.01,
voffset = 0.01
) {
median.type <- match.arg(median.type) # nolint: object_name_linter
whisker.type <- match.arg(whisker.type) # nolint: object_name_linter
common <- data.frame(
colour = data$colour,
linetype = data$linetype,
fill = alpha(data$fill, data$alpha),
stroke = data$stroke,
shape = data$shape,
group = data$group,
stringsAsFactors = FALSE
)
if (whisker.type == "line") {
whiskers <- data.frame(
x = data$x,
xend = data$x,
y = c(data$upper, data$lower),
yend = c(data$ymax, data$ymin),
size = data$size,
alpha = data$alpha,
common,
stringsAsFactors = FALSE
)
whiskers_grob <-
GeomSegment$draw_panel(whiskers, panel_scales, coord)
} else if (whisker.type == "point") {
whiskers <- data.frame(
x = data$x,
y = c(data$ymin, data$ymax),
size = data$size,
alpha = data$alpha,
common,
stringsAsFactors = FALSE
)
whiskers_grob <-
GeomPoint$draw_panel(whiskers, panel_scales, coord)
}
if (median.type == "point") {
middata <- data.frame(
x = data$x,
y = data$middle,
size = data$size * data$width,
alpha = data$alpha,
common,
stringsAsFactors = FALSE
)
middle_grob <- GeomPoint$draw_panel(middata, panel_scales, coord)
} else if (median.type == "line") {
middata <- data.frame(
y = c(data$upper, data$middle) + c(0, -data$voffset / 2),
yend = c(data$middle, data$lower) + c(data$voffset / 2, 0),
x = data$x + data$hoffset,
xend = data$x + data$hoffset,
size = data$size * data$width,
alpha = data$alpha,
common,
stringsAsFactors = FALSE
)
middle_grob <- GeomSegment$draw_panel(
middata,
panel_scales,
coord
)
}
if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) {
outliers <- data.frame(
y = data$outliers[[1]],
x = data$x[1],
colour = outlier.colour,
shape = outlier.shape,
size = outlier.size,
stroke = outlier.stroke,
fill = NA,
alpha = NA,
stringsAsFactors = FALSE
)
outliers_grob <- GeomPoint$draw_panel(
outliers,
panel_scales,
coord
)
} else {
outliers_grob <- NULL
}
ggname(
"geom_tufteboxplot",
grobTree(
outliers_grob,
whiskers_grob,
middle_grob
)
)
},
draw_legend = ggplot2::draw_key_pointrange,
default_aes = ggplot2::aes(
weight = 1,
colour = "black",
fill = "grey20",
size = 0.5,
alpha = NA,
shape = 19,
stroke = 0.5,
width = 1,
linetype = "solid",
outlier.colour = "black",
outlier.shape = 19,
outlier.size = 1.5,
outlier.stroke = 0.5
)
)
ggthemes/R/tableau.R 0000644 0001762 0000144 00000022624 15112654506 014031 0 ustar ligges users # nolint start
#' Tableau Color Palettes (discrete)
#'
#' Color palettes used in \href{https://www.tableau.com/}{Tableau}.
#'
#' @details Tableau provides three types of color palettes:
#' \code{"regular"} (discrete, qualitative categories),
#' \code{"ordered-sequential"}, and \code{"ordered-diverging"}.
#'
#' \describe{
#' \item{\code{"regular"}}{\Sexpr[results=rd]{ggthemes:::rd_optlist(names(ggthemes::ggthemes_data$tableau[["color-palettes"]][["regular"]]))}}
#' \item{\code{"ordered-diverging"}}{\Sexpr[results=rd]{ggthemes:::rd_optlist(names(ggthemes::ggthemes_data$tableau[["color-palettes"]][["ordered-diverging"]]))}}
#' \item{\code{"ordered-sequential"}}{\Sexpr[results=rd]{ggthemes:::rd_optlist(names(ggthemes::ggthemes_data$tableau[["color-palettes"]][["ordered-sequential"]]))}}
#' }
#'
#' @export
#' @param palette Palette name. See Details for available palettes.
#' @param type Type of palette. One of \code{"regular"}, \code{"ordered-diverging"}, or \code{"ordered-sequential"}.
#' @param direction If 1, the default, then use the original order of
#' colors. If -1, then reverse the order.
#'
#' @references
#' \url{http://vis.stanford.edu/color-names/analyzer/}
#'
#' Maureen Stone, 'Designing Colors for Data' (slides), at the
#' International Symposium on Computational Aesthetics in Graphics,
#' Visualization, and Imaging, Banff, AB, Canada, June 22, 2007.
#'
#' Heer, Jeffrey and Maureen Stone, 2012 'Color Naming Models for
#' Color Selection, Image Editing and Palette Design', ACM Human
#' Factors in Computing Systems (CHI)
#' \url{http://vis.stanford.edu/files/2012-ColorNameModels-CHI.pdf}.
#'
#' @family colour tableau
#' @example inst/examples/ex-tableau_color_pal.R
# nolint end
tableau_color_pal <- function(
palette = "Tableau 10",
type = c(
"regular",
"ordered-sequential",
"ordered-diverging"
),
direction = 1
) {
type <- match.arg(type)
palettes <- ggthemes::ggthemes_data[["tableau"]][["color-palettes"]][[type]]
if (!palette %in% names(palettes)) {
stop(
"`palette` must be one of ",
paste(names(palettes), collapse = ", "),
"."
)
}
values <- palettes[[palette]][["value"]]
max_n <- length(values)
f <- function(n) {
check_pal_n(n, max_n)
values <- values[seq_len(n)]
if (direction < 0) {
values <- rev(values)
}
values
}
attr(f, "max_n") <- length(values)
f
}
#' Tableau color scales (discrete)
#'
#' Categorical (qualitative) color scales used in Tableau.
#' Use the function \funclink{scale_colour_gradient_tableau} for the sequential
#' and \funclink{scale_colour_gradient2_tableau} for the diverging continuous
#' color scales from Tableu.
#'
#' @param palette Palette name. See \funclink{tableau_color_pal}
#' for available palettes.
#' @param type Palette type. One of \code{"regular"}, \code{"sequential"},
#' or \code{"diverging"}. See \funclink{tableau_color_pal}.
#' @inheritParams tableau_color_pal
#' @param ... Other arguments passed on to \code{\link[ggplot2]{discrete_scale}()}.
#' @family colour tableau
#' @rdname scale_color_tableau
#' @export
#' @seealso \code{\link{tableau_color_pal}()} for references.
#' @example inst/examples/ex-scale_color_tableau.R
scale_colour_tableau <- function(palette = "Tableau 10", type = "regular", direction = 1, ...) {
discrete_scale("colour", palette = tableau_color_pal(palette, type, direction), ...)
}
#' @export
#' @rdname scale_color_tableau
scale_fill_tableau <- function(palette = "Tableau 10", type = "regular", direction = 1, ...) {
discrete_scale("fill", palette = tableau_color_pal(palette, type, direction), ...)
}
#' @export
#' @rdname scale_color_tableau
scale_color_tableau <- scale_colour_tableau
#' Tableau Shape Palettes (discrete)
#'
#' Shape palettes used by
#' \href{https://www.tableau.com/}{Tableau}.
#'
#' Not all shape palettes in Tableau are supported. Additionally, these
#' palettes are not exact, and use the best unicode character for the shape
#' palette.
#'
#' Since these palettes use unicode characters, their look may depend on the
#' font being used, and not all characters may be available.
#'
#' Shape palettes in Tableau are used to expose images for use a markers in
#' charts, and thus are sometimes groupings of closely related symbols.
#'
#' @export
#' @param palette Palette name.
#' @family shape tableau
#' @example inst/examples/ex-tableau_shape_pal.R
tableau_shape_pal <- function(palette = c("default", "filled", "proportions")) {
palette <- match.arg(palette)
shapes <- ggthemes::ggthemes_data$tableau[["shape-palettes"]][[palette]]
f <- manual_pal(shapes[["pch"]])
attr(f, "max_n") <- nrow(shapes)
f
}
#' Tableau shape scales
#'
#' See \code{\link{tableau_shape_pal}()} for details.
#'
#' @export
#' @inheritParams tableau_shape_pal
#' @inheritParams ggplot2::scale_x_discrete
#' @family shape tableau
#' @example inst/examples/ex-scale_shape_tableau.R
scale_shape_tableau <- function(palette = "default", ...) {
discrete_scale("shape", palette = tableau_shape_pal(palette), ...)
}
# nolint start
#' Tableau colour gradient palettes (continuous)
#'
#' Gradient color palettes using the diverging and sequential continous color
#' palettes in Tableau. See \funclink{tableau_color_pal} for discrete color
#' palettes.
#'
#' @param palette Palette name.
#' \describe{
#' \item{\code{"ordered-sequential"}}{\Sexpr[results=rd]{ggthemes:::rd_optlist(names(ggthemes::ggthemes_data$tableau[["color-palettes"]][["ordered-sequential"]]))}}
#' \item{\code{"ordered-diverging"}}{\Sexpr[results=rd]{ggthemes:::rd_optlist(names(ggthemes::ggthemes_data$tableau[["color-palettes"]][["ordered-diverging"]]))}}
#' }
#' @param type Palette type, either \code{"ordered-sequential"} or
#' \code{"ordered-diverging"}.
#' @param ... Arguments passed to \code{tableau_gradient_pal}.
#' @family colour tableau
#'
#' @export
#' @example inst/examples/ex-tableau_seq_gradient_pal.R
# nolint end
tableau_gradient_pal <- function(palette = "Blue", type = "ordered-sequential") {
type <- match.arg(type, c("ordered-sequential", "ordered-diverging"))
pal <- ggthemes::ggthemes_data[[c(
"tableau",
"color-palettes",
type,
palette
)]]
scales::gradient_n_pal(colours = pal[["value"]])
}
#' @export
#' @rdname tableau_gradient_pal
tableau_seq_gradient_pal <- function(palette = "Blue", ...) {
tableau_gradient_pal(palette = palette, type = "ordered-sequential", ...)
}
#' @export
#' @rdname tableau_gradient_pal
tableau_div_gradient_pal <- function(palette = "Orange-Blue Diverging", ...) {
tableau_gradient_pal(palette = palette, type = "ordered-diverging", ...)
}
#' Tableau sequential colour scales (continuous)
#'
#' Continuous color scales using the sequential color palettes in Tableau.
#' See \funclink{scale_colour_tableau} for Tableau discrete color scales,
#' and \funclink{scale_colour_gradient2_tableau} for diverging color
#' scales.
#'
#' @export
#' @inheritParams tableau_seq_gradient_pal
#' @inheritParams ggplot2::scale_colour_hue
#' @param guide Type of legend. Use \code{'colourbar'} for continuous
#' colour bar, or \code{'legend'} for discrete colour legend.
#' @family colour tableau
#' @rdname scale_colour_gradient_tableau
#' @example inst/examples/ex-scale_colour_gradient_tableau.R
#' @importFrom ggplot2 continuous_scale
scale_colour_gradient_tableau <- function(
palette = "Blue",
...,
na.value = "grey50", # nolint: object_name_linter
guide = "colourbar"
) {
continuous_scale("colour", palette = tableau_seq_gradient_pal(palette), na.value = na.value, guide = guide, ...)
}
#' @export
#' @rdname scale_colour_gradient_tableau
scale_fill_gradient_tableau <- function(
palette = "Blue",
...,
na.value = "grey50", # nolint: object_name_linter
guide = "colourbar"
) {
continuous_scale("fill", palette = tableau_seq_gradient_pal(palette), na.value = na.value, guide = guide, ...)
}
#' @export
#' @rdname scale_colour_gradient_tableau
scale_color_gradient_tableau <- scale_colour_gradient_tableau
#' @export
#' @rdname scale_colour_gradient_tableau
scale_color_continuous_tableau <- scale_colour_gradient_tableau
#' @export
#' @rdname scale_colour_gradient_tableau
scale_fill_continuous_tableau <- scale_fill_gradient_tableau
#' Tableau diverging colour scales (continuous)
#'
#' Continuous color scales using the diverging color scales in Tableau.
#' See \funclink{scale_colour_tableau} for Tabaleau discrete color scales,
#' and \funclink{scale_colour_gradient_tableau} for sequential color scales.
#'
#' @inheritParams tableau_div_gradient_pal
#' @inheritParams ggplot2::scale_colour_hue
#' @param guide Type of legend. Use \code{'colourbar'} for continuous
#' colour bar, or \code{'legend'} for discrete colour legend.
#' @family colour tableau
#' @export
#' @rdname scale_colour_gradient2_tableau
#' @example inst/examples/ex-scale_colour_gradient2_tableau.R
scale_colour_gradient2_tableau <- function(
palette = "Orange-Blue Diverging",
...,
na.value = "grey50", # nolint: object_name_linter
guide = "colourbar"
) {
continuous_scale("colour", palette = tableau_div_gradient_pal(palette), na.value = na.value, guide = guide, ...)
}
#' @export
#' @rdname scale_colour_gradient2_tableau
scale_fill_gradient2_tableau <- function(
palette = "Orange-Blue Diverging",
...,
na.value = "grey50", # nolint: object_name_linter
guide = "colourbar"
) {
continuous_scale("fill", palette = tableau_div_gradient_pal(palette), na.value = na.value, guide = guide, ...)
}
#' @export
#' @rdname scale_colour_gradient2_tableau
scale_color_gradient2_tableau <- scale_colour_gradient2_tableau
ggthemes/R/gdocs.R 0000644 0001762 0000144 00000006727 15112654506 013521 0 ustar ligges users #' Theme with Google Docs Chart defaults
#'
#' Theme similar to the default look of charts in Google Docs.
#'
#' @inheritParams ggplot2::theme_grey
#' @export
#' @family themes gdocs
#' @example inst/examples/ex-theme_gdocs.R
theme_gdocs <- function(base_size = 12, base_family = "sans") {
ltgray <- "#cccccc"
dkgray <- "#757575"
dkgray2 <- "#666666"
theme_foundation(
base_size = base_size,
base_family = base_family
) +
theme(
rect = element_rect(colour = "black", fill = "white"),
line = element_line(colour = "black"),
text = element_text(colour = dkgray),
# title is aligned left, 20 point Roboto Font, plain
plot.title = element_text(
face = "plain",
size = rel(20 / 12),
hjust = 0,
colour = dkgray
),
# No subtitle or captions, so treat like other text
plot.subtitle = element_text(
hjust = 0,
size = rel(1),
face = "plain",
colour = dkgray
),
plot.caption = element_text(
hjust = 0,
size = rel(1),
face = "plain",
colour = dkgray
),
panel.background = element_rect(fill = NA, colour = NA),
panel.border = element_rect(fill = NA, colour = NA),
# no strips in gdocs, so make similar to axis titles
strip.text = element_text(
hjust = 0,
size = rel(1),
colour = dkgray2,
face = "plain"
),
strip.background = element_rect(colour = NA, fill = NA),
# axis titles: Roboto 12pt, plain.
axis.title = element_text(
face = "plain",
colour = dkgray2,
size = rel(1)
),
# axis text: Roboto 12pt, plain
axis.text = element_text(
face = "plain",
colour = dkgray,
size = rel(1)
),
# only axis line on the x-axis. black.
axis.line = element_line(colour = "black"),
axis.line.y = element_blank(),
# no axis ticks
axis.ticks = element_blank(),
# grid lines on both x and y axes. light gray. no minor gridlines
panel.grid.major = element_line(colour = ltgray),
panel.grid.minor = element_blank(),
# legend has no border
legend.background = element_rect(colour = NA),
# legend labels: Roboto 12, dark gray
legend.text = element_text(
size = rel(1),
colour = dkgray
),
# no legend title - use same as legend text
legend.title = element_text(
size = rel(1),
colour = dkgray2,
face = "plain"
),
legend.key = element_rect(colour = NA),
legend.position = "right",
legend.direction = "vertical"
)
}
#' Google Docs color palette (discrete)
#'
#' Color palettes from Google Docs.
#' This palette includes 20 colors.
#'
#' @family colour gdocs
#' @export
#' @example inst/examples/ex-gdocs_pal.R
gdocs_pal <- function() {
values <- ggthemes::ggthemes_data$gdocs$colors$value
f <- manual_pal(values)
attr(f, "max_n") <- length(values)
f
}
#' Google Docs color scales
#'
#' Color scales from Google Docs.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @family colour gdocs
#' @rdname scale_gdocs
#' @export
#' @seealso See \code{\link{theme_gdocs}()} for examples.
scale_fill_gdocs <- function(...) {
discrete_scale("fill", palette = gdocs_pal(), ...)
}
#' @export
#' @rdname scale_gdocs
scale_colour_gdocs <- function(...) {
discrete_scale("colour", palette = gdocs_pal(), ...)
}
#' @export
#' @rdname scale_gdocs
scale_color_gdocs <- scale_colour_gdocs
ggthemes/R/geom-rangeframe.R 0000644 0001762 0000144 00000006663 15112461554 015454 0 ustar ligges users #' Range Frames
#'
#' Axis lines which extend to the maximum and minimum of the plotted data.
#'
#' @section Aesthetics:
#' \itemize{
#' \item colour
#' \item size
#' \item linetype
#' \item alpha
#' }
#'
#' @inheritParams ggplot2::geom_point
#' @param sides A string that controls which sides of the plot the frames appear on.
#' It can be set to a string containing any of \code{'trbl'}, for top, right,
#' bottom, and left.
#' @export
#'
#' @details This should be used with `coord_cartesian(clip="off")` in order to
#' correctly draw the lines.
#'
#' @references Tufte, Edward R. (2001) The Visual Display of
#' Quantitative Information, Chapter 6.
#'
#' @family geom tufte
#' @importFrom ggplot2 layer
#' @example inst/examples/ex-geom_rangeframe.R
geom_rangeframe <- function(
mapping = NULL,
data = NULL,
stat = "identity",
position = "identity",
...,
sides = "bl",
na.rm = FALSE, # nolint: object_name_linter
show.legend = NA, # nolint: object_name_linter
inherit.aes = TRUE # nolint: object_name_linter
) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomRangeFrame,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
sides = sides,
na.rm = na.rm,
...
)
)
}
#' @rdname geom_rangeframe
#' @usage NULL
#' @format NULL
#' @export
#' @importFrom ggplot2 Geom
#' @importFrom scales alpha
# nolint start: object_name_linter
GeomRangeFrame <- ggplot2::ggproto(
"GeomRangeFrame",
ggplot2::Geom,
optional_aes = c("x", "y"),
draw_panel = function(data, panel_scales, coord, sides = "bl") {
rugs <- list()
data <- coord[["transform"]](data, panel_scales)
gp <- gpar(
col = alpha(data[["colour"]], data[["alpha"]]),
lty = data[["linetype"]],
lwd = data[["size"]] * ggplot2::.pt
)
if (!is.null(data[["x"]])) {
if (grepl("b", sides)) {
rugs[["x_b"]] <- ggname(
"range_x_b",
segmentsGrob(
x0 = unit(min(data[["x"]]), "native"),
x1 = unit(max(data[["x"]]), "native"),
y0 = unit(0, "npc"),
y1 = unit(0, "npc"),
gp = gp
)
)
}
if (grepl("t", sides)) {
rugs[["x_t"]] <- ggname(
"range_x_t",
segmentsGrob(
x0 = unit(min(data[["x"]]), "native"),
x1 = unit(max(data[["x"]]), "native"),
y0 = unit(1, "npc"),
y1 = unit(1, "npc"),
gp = gp
)
)
}
}
if (!is.null(data[["y"]])) {
if (grepl("l", sides)) {
rugs[["y_l"]] <- ggname(
"range_y_l",
segmentsGrob(
y0 = unit(min(data[["y"]]), "native"),
y1 = unit(max(data[["y"]]), "native"),
x0 = unit(0, "npc"),
x1 = unit(0, "npc"),
gp = gp
)
)
}
if (grepl("r", sides)) {
rugs[["y_r"]] <- ggname(
"range_y_r",
segmentsGrob(
y0 = unit(min(data[["y"]]), "native"),
y1 = unit(max(data[["y"]]), "native"),
x0 = unit(1, "npc"),
x1 = unit(1, "npc"),
gp = gp
)
)
}
}
ggname("geom_rangeframe", gTree(children = do.call("gList", rugs)))
},
default_aes = ggplot2::aes(
colour = "black",
size = 0.5,
linetype = 1,
alpha = NA
),
draw_key = ggplot2::draw_key_path
)
# nolint end: object_name_linter
ggthemes/R/ggthemes_data.R 0000644 0001762 0000144 00000000330 15112366564 015202 0 ustar ligges users #' Palette and theme data
#'
#' The \code{ggthemes} environment contains various values used in
#' themes and palettes. This is undocumented and subject to change.
#'
#' @format A \code{list} object.
"ggthemes_data"
ggthemes/R/tufte.R 0000644 0001762 0000144 00000003112 15112373173 013530 0 ustar ligges users #' Tufte Maximal Data, Minimal Ink Theme
#'
#' Theme based on Chapter 6 'Data-Ink Maximization and Graphical
#' Design' of Edward Tufte *The Visual Display of Quantitative
#' Information*. No border, no axis lines, no grids. This theme works
#' best in combination with \code{\link[ggplot2]{geom_rug}()} or
#' \code{\link{geom_rangeframe}()}.
#'
#' @note
#' The default font family is set to 'serif' as he uses serif fonts
#' for labels in 'The Visual Display of Quantitative Information'.
#' The serif font used by Tufte in his books is a variant of Bembo,
#' while the sans serif font is Gill Sans. If these fonts are
#' installed on your system, then you can use them with the package
#' \bold{extrafont}.
#'
#' @inheritParams ggplot2::theme_grey
#' @param ticks \code{logical} Show axis ticks?
#'
#' @references Tufte, Edward R. (2001) The Visual Display of
#' Quantitative Information, Chapter 6.
#'
#' @family themes tufte
#' @example inst/examples/ex-theme_tufte.R
#' @export
#' @importFrom ggplot2 theme_bw
theme_tufte <- function(base_size = 11, base_family = "serif", ticks = TRUE) {
## TODO: start with theme_minimal
ret <- theme_bw(base_family = base_family, base_size = base_size) +
theme(
legend.background = element_blank(),
legend.key = element_blank(),
panel.background = element_blank(),
panel.border = element_blank(),
strip.background = element_blank(),
plot.background = element_blank(),
axis.line = element_blank(),
panel.grid = element_blank()
)
if (!ticks) {
ret <- ret + theme(axis.ticks = element_blank())
}
ret
}
ggthemes/R/excel.R 0000644 0001762 0000144 00000013407 15112676746 013525 0 ustar ligges users #' Excel 97 ugly color palettes (discrete)
#'
#' The color palettes used in Microsoft Excel 97 (and up until Excel 2007).
#' Use this for that classic ugly look and feel. For ironic purposes only.
#' 3D bars and pies not included. Please never use this color palette.
#'
#' @param line If \code{TRUE}, use the palette for lines and points. Otherwise,
#' use the palette for area.
#' @family colour excel
#' @export
#' @example inst/examples/ex-excel_pal.R
excel_pal <- function(line = TRUE) {
if (line[[1]]) {
manual_pal(ggthemes::ggthemes_data$excel$classic$line)
} else {
manual_pal(ggthemes::ggthemes_data$excel$classic$fill)
}
}
#' Excel (current versions) color palettes (discrete)
#'
#' Color palettes used by current versions of Microsoft Office and Excel.
#'
#' @param theme The name of the Office theme or color theme
#' (not to be confused with ggplot2 themes) from which to derive the color
#' palette. Available themes include:
#' \Sexpr[results=rd]{ggthemes:::rd_optlist(names(ggthemes::ggthemes_data$excel$themes))}
#' @family colour excel
#' @example inst/examples/ex-excel_new_pal.R
#' @export
excel_new_pal <- function(theme = "Office Theme") {
allthemes <- ggthemes::ggthemes_data$excel$themes
if (!theme %in% names(allthemes)) {
stop("`theme` must be one of ", paste0(names(allthemes), collapse = ", "))
}
values <- unname(allthemes[[theme]][["accents"]])
f <- manual_pal(values)
attr(f, "max_n") <- length(values)
f
}
#' Excel 97 ugly color scales
#'
#' The classic "ugly" color scales from Excel 97.
#'
#' @inheritParams excel_pal
#' @inheritParams ggplot2::scale_colour_hue
#' @family colour excel
#' @rdname scale_excel
#' @export
#' @example inst/examples/ex-theme_excel.R
scale_fill_excel <- function(...) {
discrete_scale("fill", palette = excel_pal(line = FALSE), ...)
}
#' @export
#' @rdname scale_excel
scale_colour_excel <- function(...) {
discrete_scale("colour", palette = excel_pal(line = TRUE), ...)
}
#' @export
#' @rdname scale_excel
scale_color_excel <- scale_colour_excel
#' Excel (current versions) color scales
#'
#' Discrete color scales used in current versions of Microsoft Office and Excel.
#'
#' @inheritParams excel_new_pal
#' @inheritParams ggplot2::scale_colour_hue
#' @family colour excel
#' @rdname scale_excel_new
#' @example inst/examples/ex-theme_excel_new.R
#' @export
scale_colour_excel_new <- function(theme = "Office Theme", ...) {
discrete_scale("colour", palette = excel_new_pal(theme), ...)
}
#' @export
#' @rdname scale_excel_new
scale_color_excel_new <- scale_colour_excel_new
#' @export
#' @rdname scale_excel_new
scale_fill_excel_new <- function(theme = "Office Theme", ...) {
discrete_scale("fill", palette = excel_new_pal(theme), ...)
}
#' ggplot theme based on old Excel plots
#'
#' Theme to replicate the ugly monstrosity that was the old
#' gray-background Excel chart. Please never use this.
#' This theme should be combined with the \code{\link{scale_colour_excel}()}
#' color scale.
#'
#' @inheritParams ggplot2::theme_grey
#' @param horizontal \code{logical}. Horizontal axis lines?
#' @return An object of class \code{\link[ggplot2]{theme}()}.
#' @export
#' @family themes excel
#' @example inst/examples/ex-theme_excel.R
theme_excel <- function(base_size = 12, base_family = "", horizontal = TRUE) {
gray <- "#C0C0C0"
ret <- (theme_bw() +
theme(
panel.background = element_rect(fill = gray),
panel.border = element_rect(
colour = "black",
linetype = 1
),
panel.grid.major = element_line(colour = "black"),
panel.grid.minor = element_blank(),
legend.key = element_rect(colour = NA),
legend.background = element_rect(colour = "black", linetype = 1),
strip.background = element_rect(
fill = "white",
colour = NA,
linetype = 0
)
))
if (horizontal) {
ret <- ret + theme(panel.grid.major.x = element_blank())
} else {
ret <- ret + theme(panel.grid.major.y = element_blank())
}
ret
}
#' ggplot theme similar to current Excel plot defaults
#'
#' Theme for ggplot2 that is similar to the default style of charts in
#' current versions of Microsoft Excel.
#'
#' @inheritParams ggplot2::theme_grey
#' @return An object of class \code{\link[ggplot2]{theme}()}.
#' @export
#' @family themes excel
#' @example inst/examples/ex-theme_excel_new.R
#'
theme_excel_new <- function(base_size = 9, base_family = "sans") {
colorlist <- list(
lt_gray = "#D9D9D9",
gray = "#BFBFBF",
dk_gray = "#595959"
)
theme_bw(
base_family = base_family,
base_size = base_size
) +
theme(
text = element_text(
colour = colorlist$dk_gray,
size = base_size
),
line = element_line(
linetype = "solid",
colour = colorlist$gray
),
rect = element_rect(
linetype = 0,
colour = "white"
),
panel.grid.major = element_line(
linetype = "solid",
colour = colorlist$gray,
linewidth = 0.75 * PT_TO_MM
),
panel.grid.minor = element_blank(),
axis.title = element_blank(),
axis.text = element_text(
colour = colorlist$dk_gray,
size = 9
),
strip.background = element_rect(
fill = NA
),
strip.text = element_text(
colour = colorlist$dk_gray,
size = 9
),
axis.ticks = element_blank(),
panel.background = element_blank(),
panel.border = element_rect(colour = NA),
title = element_text(
face = "plain",
hjust = 0.5
),
plot.title = element_text(
size = 14,
hjust = 0.5
),
plot.subtitle = element_blank(),
legend.position = "bottom",
legend.text = element_text(
size = 9,
colour = colorlist$dk_gray
),
legend.title = element_blank(),
)
}
ggthemes/R/utils.R 0000644 0001762 0000144 00000002047 15112461554 013550 0 ustar ligges users #' Magic Number: Points to Millimeters
#' @noRd
PT_TO_MM <- 0.352778 # nolint: object_name_linter
charopts <- function(x) {
paste(sprintf("\\code{\"%s\"}", x), collapse = ", ")
}
# copied from ggplot2
"%||%" <- function(a, b) {
if (!is.null(a)) a else b
}
# copied from ggplot2
ggname <- function(prefix, grob) {
grob$name <- grid::grobName(grob, prefix)
grob
}
rd_optlist <- function(x) {
paste0("\\code{\"", as.character(x), "\"}", collapse = ", ")
}
check_pal_n <- function(n, max_n) {
if (n > max_n) {
warning(
"This palette can handle a maximum of ",
max_n,
" values.",
"You have supplied ",
n,
"."
)
} else if (n < 0) {
stop("`n` must be a non-negative integer.")
}
}
#' Extract colors from ggthemes data
#'
#' @param path A character vector of the path in \code{ggthemes_data}.
#' @param colors A character vector of color names.
#' @noRd
get_colors <- function(path, colors) {
x <- dplyr::filter(ggthemes::ggthemes_data[[path]], .data$name %in% colors)
x <- unname(x[["value"]])
}
ggthemes/R/colorblind.R 0000644 0001762 0000144 00000003144 15112676746 014551 0 ustar ligges users #' Colorblind Color Palette (Discrete) and Scales
#'
#' An eight-color colorblind safe qualitative discrete palette.
#'
#' @rdname colorblind
#' @references
#' Chang, W. "\href{http://www.cookbook-r.com/Graphs/Colors_(ggplot2)/#a-colorblind-friendly-palette}{Cookbook for R}"
#'
#' \verb{https://jfly.iam.u-tokyo.ac.jp/color}
#'
#' @export
#' @inheritParams ggplot2::scale_colour_hue
#' @family colour
#' @seealso The \pkg{dichromat} package, \code{\link[scales]{dichromat_pal}()},
#' and \code{\link{scale_color_tableau}()} for other colorblind palettes.
#' @example inst/examples/ex-colorblind.R
colorblind_pal <- function() {
values <- unname(ggthemes::ggthemes_data[["colorblind"]][["value"]])
f <- manual_pal(values)
attr(f, "max_n") <- length(values)
f
}
#' @rdname colorblind
#' @export
colourblind_pal <- colorblind_pal
#' @rdname colorblind
#' @export
scale_colour_colourblind <- function(...) {
discrete_scale("colour", palette = colorblind_pal(), ...)
}
#' @rdname colorblind
#' @export
#' @importFrom lifecycle deprecate_soft
scale_colour_colorblind <- function(...) {
deprecate_soft("5.2.0", "scale_color_colorblind()")
scale_colour_colourblind(...)
}
#' @rdname colorblind
#' @export
scale_color_colorblind <- scale_colour_colourblind
#' @rdname colorblind
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' @export
#' @importFrom lifecycle deprecate_soft
scale_fill_colorblind <- function(...) {
deprecate_soft("5.2.0", "scale_fill_colorblind()")
discrete_scale("fill", palette = colorblind_pal(), ...)
}
#' @rdname colorblind
#' @export
scale_fill_colourblind <- scale_fill_colorblind
ggthemes/R/canva.R 0000644 0001762 0000144 00000004425 15112654506 013503 0 ustar ligges users # nolint start
#' 150 Color Palettes from Canva
#'
#' 150 four-color palettes by the
#' \href{https://www.canva.com/learn/}{canva.com} design school.
#' These palettes were derived from photos and "impactful websites".
#'
#' @format A named \code{list} of character vector.
#' The names are the palette names. The values of the character vectors
#' are hex colors, e.g. \code{"#f98866"}.
#'
#' @references
#' \itemize{
#' \item{Janie Kliever, \href{https://www.canva.com/learn/100-color-combinations/}{100 Brilliant Color Combinations and How to Apply Them to Your Designs},
#' \emph{Canva.com}, June 20, 2015.}
#' \item{Mary Stribley, \href{https://www.canva.com/learn/website-color-schemes/}{Website Color Schemes: The Palettes of 50 Visually Impactful Websites to Inspire You},
#' \emph{Canva.com}, January 26, 2016.}
#' \item{Schwabish, Jonathan.
#' \href{https://policyviz.com/2017/01/12/150-color-palettes-for-excel/}{150+ Color Palettes for Excel},
#' \emph{PolicyViz}, January 12, 2017.}
#' }
#' @example inst/examples/ex-canva_pal.R
"canva_palettes"
# nolint end
#' Canva.com color palettes
#'
#' 150+ color palettes from canva.com. See \code{\link{canva_palettes}()}.
#'
#' @param palette Palette name. See the names of \code{\link{canva_palettes}()}
#' for valid names.
#' @return A function that takes a single value, the number of colors to use.
#' @export
#' @example inst/examples/ex-canva_pal.R
canva_pal <- function(palette = "Fresh and bright") {
if (!palette %in% names(ggthemes::canva_palettes)) {
stop("Palette ", sQuote(palette), " not a valid name.", call. = FALSE)
}
manual_pal(unname(ggthemes::canva_palettes[[palette]]))
}
#' Discrete color scale using canva.com color palettes
#'
#' Color scale for canva.com color palettes described in
#' \code{\link{canva_palettes}()}.
#'
#' @param ... Arguments passed to \code{\link[ggplot2]{discrete_scale}()}.
#' @inheritParams canva_pal
#' @export
scale_colour_canva <- function(..., palette = "Fresh and bright") {
discrete_scale("colour", palette = canva_pal(palette), ...)
}
#' @export
#' @rdname scale_colour_canva
scale_color_canva <- scale_colour_canva
#' @export
#' @rdname scale_colour_canva
scale_fill_canva <- function(..., palette = "Fresh and bright") {
discrete_scale("fill", palette = canva_pal(palette), ...)
}
ggthemes/R/base.R 0000644 0001762 0000144 00000030033 15112461554 013316 0 ustar ligges users #' Theme Base
#'
#' Theme similar to the default settings of the \sQuote{base} R graphics.
#'
#' @inheritParams ggplot2::theme_bw
#' @export
#' @family themes
#' @example inst/examples/ex-theme_base.R
theme_base <- function(base_size = 16, base_family = "") {
theme_foundation() +
theme(
line = element_line(
colour = "black",
lineend = "round",
linetype = "solid"
),
rect = element_rect(
fill = "white",
colour = "black",
linetype = "solid"
),
text = element_text(
colour = "black",
face = "plain",
family = base_family,
size = base_size,
vjust = 0.5,
hjust = 0.5,
lineheight = 1
),
panel.grid = element_blank(),
strip.background = element_rect(colour = NA),
legend.key = element_rect(colour = NA),
title = element_text(size = rel(1)),
plot.title = element_text(size = rel(1.2), face = "bold"),
strip.text = element_text(),
axis.ticks.length = unit(0.5, "lines")
)
# TODO: get margins right
}
# Notes for generating a theme that uses par() for its values.
#
# $xlog
# [1] TRUE
#
# $ylog
# [1] TRUE
#
# Justification of strings in text, mtext, and title
# # text = element_text(vjust = par()$adj, hjust = par$adj())
# $adj
# [1] 0.5
#
# $ann
# [1] TRUE
#
# $ask
# [1] FALSE
#
# Background. rect = element_rect(fill = par()$bg)
# $bg
# [1] "white"
#
# # Type of box drawn around the plot
# # Which sides of the box to draw
# $bty
# [1] "o"
#
# # magnification of text and symbols relative to the default. ggplot uses base_size instead.
# $cex
# [1] 1
#
# # mag of axis relative to current setting of cex
# # axis.text = element_text(size = rel(par()$cex.axis))
# $cex.axis
# [1] 1
# # mag of axis relative to current setting of cex
# # axis.title = element_text(size = rel(par()$cex.lab))
# $cex.lab
# [1] 1
#
# # magnification of plot title relative to cex
# # plot.title = element_text(size = rel(par()$cex.main))
# $cex.main
# [1] 1.2
#
# # ggplot does not have subtitles
# # magnification of subtitle relative to cex
# # strip.title = element_text(size = rel(par()$cex.sub))
# $cex.sub
# [1] 1
#
# $cin
# # character size in inches
# [1] 0.2000000 0.2666667
#
# # default plotting color - not part of theme in gggplot
# $col
# [1] "black"
#
# # color for axis annotation
# #
# $col.axis
# [1] "black"
# # color for x and y labels
# # axis.text = element_text(colour = par()$col.axis)
#
# # color for x and y labels
# # axis.title = element_text(colour = par()$col.lab)
# $col.lab
# [1] "black"
#
# # color for main titles
# # plot.title = element_text(colour = par()$col.main)
# $col.main
# [1] "black"
#
# # color for subtitles
# # strip.title = element_text(colour = par()$col.sub)
# $col.sub
# [1] "black"
#
# # size of default character
# $cra
# [1] 14.4 19.2
#
# # numerical values for how single characters rotated. Nothing similar in ggplot
# $crt
# [1] 0
#
# # size of default characters in inches
# # Is this base size?
# $csi
# [1] 0.2666667
#
# # size of default character in user coord
# # not relevant
# $cxy
# [1] 0.1859782 0.3665854
#
# # device dimensions. not relevant
# $din
# [1] 11.236111 8.847222
#
# # error reporting. not relevant
# $err
# [1] 0
#
# # default font family
# # base_family = par()$family
# $family
# [1] ""
#
# # color of foreground in plots. Used in axes and boxes around plots.
# line = element_line(colour = par()$fg)
# rect = element_rect(colour = par()$fg)
# text = = element_text(colour = par()$fg)
# $fg
# [1] "black"
#
# # gives NDC coordinates of figure region in display device
# $fig
# [1] 0 1 0 1
#
# # figure region dimensions in inches
# # TODO: use for aspect ratio?
# $fin
# [1] 11.236111 8.847222
#
# # which font to use for text.
# # 1 = "plain"
# # 2 = "bold"
# # 3 = "italic"
# # 4 = "bold.italic"
# text = element_text(face = c("plain", "bold", "italic", "bold.italic")[par()$font])
# $font
# [1] 1
#
# # font to use for axis
# axis.text = element_text(face = c("plain", "bold", "italic", "bold.italic")[par()$font])
# $font.axis
# [1] 1
#
# axis.title = element_text(face = c("plain", "bold", "italic", "bold.italic")[par()$font])
# $font.lab
# [1] 1
#
# axis.title = element_text(face = c("plain", "bold", "italic", "bold.italic")[par()$font])
# $font.main
# [1] 2
#
# strip.title = element_text(face = c("plain", "bold", "italic", "bold.italic")[par()$font])
# $font.sub
# [1] 1
#
# # default number of tick-marks in x and y, and label lenghth.
# Not sure how that can be used
# $lab
# [1] 5 5 7
#
# # style of axis labels.
# # TODO: code that sets axis.text.x and axis.text.y angle according to its values.
# $las
# [1] 0
#
# # line end style
# line = element_line(lineend = par()$lend)
# $lend
# [1] "round"
#
# # line height
# text = element_text(lineheight = par()$lheight * par()$??)
# $lheight
# [1] 1
#
# # Line join style
# # not sure how this is used in ggplot
# $ljoin
# [1] "round"
#
# # line mitre imit. Not used in ggplot2.
# $lmitre
# [1] 10
#
# # Line type
# # line = element_line(linetype = par()$lty)
# $lty
# [1] "solid"
#
# # Line width?
# # Does this set size? ??
# # Maybe: line = element_line(size = par()$lwd)
# $lwd
# [1] 1
#
# # margin size in inches
# plot.margin = par()$mai
# $mai
# [1] 1.360000 1.093333 1.093333 0.560000
#
# # Number of lines of margin. How is this different than mai?
# $mar
# [1] 5.1 4.1 4.1 2.1
#
# $mex
# [1] 1
#
# # changes layout. ggplot uses facets.
# $mfcol
# [1] 1 1
#
# # used for layout
# $mfg
# [1] 1 1 1 1
#
# # changes layout. ggplot uses facets.
# $mfrow
# [1] 1 1
#
# # margine line in mex units for axis title, axis labels, and axis.line
# $mgp
# [1] 3 1 0
#
# # ignored in R
# $mkh
# [1] 0.001
#
# # irrelevant to ggplot
# $new
# [1] FALSE
#
# # size of outer margins in lines of text
# # TODO: what is this in ggplot
# $oma
# [1] 0 0 0 0
#
# # regions inside out margins in NDC
# # TODO: ?
# $omd
# [1] 0 1 0 1
#
# # size of outer margins in inches
# # TODO???
# $omi
# [1] 0 0 0 0
#
# # irrelevant
# $page
# [1] TRUE
#
# # dfault plotting symbol. not in themes.
# $pch
# [1] 1
#
# # Plot dimensions in inches.
# $pin
# [1] 9.582778 6.393889
#
# # Plot region as fractions of current figure region.
# $plt
# [1] 0.09730532 0.95016069 0.15372057 0.87642072
#
# # point size of text (not symbols)
# base_size = par()$ps
# $ps
# [1] 16
#
# # type of region to be drawn. s = square. m = maximal.
# # not sure how this maps to ggplot
# $pty
# [1] "m"
#
# # not used
# $smo
# [1] 1
#
# # string rotation in degrees
# # this is for text() plots not titles and labels
# $srt
# [1] 0
#
# # length of tick marks
# # use this to set axis.ticks.length
# $tck
# [1] NA
#
# # length of tick marks
# $tcl
# [1] -0.5
#
# # extremes of user coord of plotting regsion
# $usr
# [1] -0.0381697 0.9924122 0.2730712 1.0279588
#
# # used for generating ticks
# $xaxp
# [1] 1 10 3
#
# # used to generate axis
# $xaxs
# [1] "r"
#
# # any values other than "n" implies plotting x axis.
# $xaxt
# [1] "s"
#
# $xpd
# [1] FALSE
#
# $yaxp
# [1] 2 10 -4
#
# $yaxs
# [1] "r"
#
# # any value other than "n" implies plotting y axis.
# $yaxt
# [1] "s"
#
# # positioning of text in margins by axis and mtext.
# $ylbias
# [1] 0.2
# #' Theme Par
#'
#' Theme which uses the current \sQuote{base} graphics parameter values
#' from \code{\link[graphics]{par}()}.
#' Not all \code{par()} parameters, are supported, and not all are relevant to
#' \pkg{ggplot2} themes.
#'
#' Currently this theme uses the values of the parameters:
#' \code{"code"}, "\code{"ps"}", \code{"code"} \code{"family"}, \code{"fg"},
#' \code{"bg"}, \code{"adj"}, \code{"font"}, \code{"cex.axis"},
#' \code{"cex.lab"}, \code{"cex.main"}, \code{"cex.sub"}, \code{"col.axis"},
#' \code{"col.lab"}, \code{"col.main"}, \code{"col.sub"}, \code{"font"},
#' \code{"font.axis"}, \code{"font.lab"}, \code{"font.main"},
#' \code{"font.sub"}, \code{"las"}, \code{"lend"},
#' \code{"lheight"}, \code{"lty"}, \code{"mar"}, \code{"ps"}, \code{"tcl"},
#' \code{"tck"}, \code{"xaxt"}, \code{"yaxt"}.
#'
#' This theme does not translate the base graphics perfectly, so the graphs
#' produced by it will not be identical to those produced by base graphics,
#' most notably in the spacing of the margins.
#'
#' @inheritParams ggplot2::theme_bw
#' @export
#' @family themes
#' @example inst/examples/ex-theme_par.R
theme_par <- function(base_size = par()$ps, base_family = par()$family) {
faces <- c("plain", "bold", "italic", "bold.italic")
half_line <- base_size / 2
thm <- theme_foundation() %+replace%
theme(
line = element_line(
colour = par()$fg,
linewidth = 0.5,
lineend = par()$lend,
linetype = par()$lty
),
rect = element_rect(
fill = par()$bg,
colour = par()$fg,
linewidth = 0.5,
linetype = par()$lty
),
text = element_text(
colour = par()$fg,
face = faces[par()$font],
family = base_family,
size = base_size,
angle = 0,
margin = margin(),
vjust = par()$adj,
hjust = par()$adj,
lineheight = par()$lheight,
debug = FALSE
),
axis.title = element_text(
size = rel(par()$cex.lab),
colour = par()$col.lab,
face = faces[par()$font.lab]
),
axis.text = element_text(
size = rel(par()$cex.axis),
colour = par()$col.axis,
face = faces[par()$font.axis]
),
axis.text.x = element_text(
margin = margin(
t = 0.8 * half_line / 2,
b = 0.8 * half_line / 2
)
),
axis.text.y = element_text(
margin = margin(
r = 0.8 * half_line / 2,
l = 0.8 * half_line / 2
)
),
axis.ticks = element_line(colour = par()$fg),
legend.title = element_text(colour = par()$fg),
legend.text = element_text(colour = par()$fg),
legend.spacing = unit(0.2, "cm"),
legend.key = element_rect(colour = NA),
panel.spacing = unit(half_line, "pt"),
panel.spacing.x = NULL,
panel.spacing.y = NULL,
panel.background = element_rect(fill = NA, colour = par()$col),
panel.grid = element_blank(),
plot.background = element_rect(colour = NA),
plot.margin = unit(par()$mar, "lines"),
plot.title = element_text(
size = rel(par()$cex.main),
face = faces[par()$font.main],
colour = par()$col.main,
margin = margin(b = half_line * 1.2)
),
strip.text = element_text(
size = rel(par()$cex.sub),
face = faces[par()$font.sub],
colour = par()$col.sub
),
strip.text.x = element_text(
margin = margin(
t = half_line,
b = half_line
)
),
strip.text.y = element_text(
margin = margin(
l = half_line,
r = half_line
)
),
strip.background = element_rect(colour = NA)
)
las <- par()$las
if (las == 0) {
# parallel to axis
thm <- thm +
theme(
axis.title.x = element_text(angle = 0),
axis.title.y = element_text(angle = 90)
)
} else if (las == 1) {
# horizontal
thm <- thm +
theme(
axis.title.x = element_text(angle = 0),
axis.title.y = element_text(angle = 0)
)
} else if (las == 2) {
# perpendicular
thm <- thm +
theme(
axis.title.x = element_text(angle = 90),
axis.title.y = element_text(angle = 0)
)
} else if (las == 3) {
# vertical
thm <- thm +
theme(
axis.title.x = element_text(angle = 90),
axis.title.y = element_text(angle = 90)
)
}
# ticks
if (!is.na(par()$tck)) {
thm <- thm + theme(axis.ticks.length = unit(-par()$tck, "snpc"))
} else {
thm <- thm + theme(axis.ticks.length = unit(-par()$tcl, "lines"))
}
# plot x or y axis
if (par()$xaxt == "n") {
thm <- thm +
theme(
axis.line.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
)
}
if (par()$yaxt == "n") {
thm <- thm +
theme(
axis.line.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank()
)
}
thm
# TODO: get margins right
}
ggthemes/R/stat-fivenumber.R 0000644 0001762 0000144 00000006575 15112461554 015535 0 ustar ligges users #' Calculate components of a five-number summary
#'
#' The five number summary of a sample is the minimum, first quartile,
#' median, third quartile, and maximum.
#'
#' @param na.rm If \code{FALSE} (the default), removes missing values with
#' a warning. If \code{TRUE} silently removes missing values.
#' @param probs Quantiles to use for the five number summary.
#' @inheritParams ggplot2::stat_identity
#' @return A data frame with additional columns:
#' \item{width}{width of boxplot}
#' \item{min}{minimum}
#' \item{lower}{lower hinge, 25\% quantile}
#' \item{middle}{median, 50\% quantile}
#' \item{upper}{upper hinge, 75\% quantile}
#' \item{max}{maximum}
#' @seealso \code{\link[ggplot2]{stat_boxplot}()}
#' @export
stat_fivenumber <- function(
mapping = NULL,
data = NULL,
geom = "boxplot",
probs = c(0, 0.25, 0.5, 0.75, 1),
na.rm = FALSE, # nolint: object_name_linter
position = "identity",
show.legend = NA, # nolint: object_name_linter
inherit.aes = TRUE, # nolint: object_name_linter
...
) {
layer(
data = data,
mapping = mapping,
stat = StatFivenumber,
geom = geom,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
probs = probs,
na.rm = na.rm,
...
)
)
}
# From ggplot2:::NO_GROUP
NO_GROUP <- -1 # nolint: object_name_linter
# Copied from ggplot2:::has_groups
has_groups <- function(data) {
data$group[1L] != NO_GROUP
}
# nolint start: object_name_linter
#' @export
#' @format NULL
#' @usage NULL
#' @rdname stat_fivenumber
#' @importFrom ggplot2 resolution remove_missing
StatFivenumber <- ggplot2::ggproto(
# nolint
"StatFivenumber",
ggplot2::Stat, # nolint: object_name_linter
required_aes = "y",
non_missing_aes = "weight",
setup_data = function(data, params) {
data$x <- data$x %||% 0
data <- remove_missing(
data,
na.rm = FALSE,
vars = "x",
name = "stat_fivenumber"
)
data
},
setup_params = function(data, params) {
params$width <- params$width %||% (resolution(data$x %||% 0) * 0.75)
if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) {
warning(
"Continuous x aesthetic -- did you forget aes(group=...)?",
call. = FALSE
)
}
params
},
compute_group = function(
data,
scales,
width = NULL,
na.rm = FALSE, # nolint: object_name_linter
probs = c(0, 0.25, 0.5, 0.75, 1)
) {
if (length(probs) != 5) {
stop("'probs' should contain 5 quantiles.")
}
probs <- sort(probs)
if (!is.null(data$weight)) {
if (!requireNamespace("quantreg", quietly = TRUE)) {
stop("Package 'quantreg' is required for compute_group() with weights.")
}
mod <- quantreg::rq(y ~ 1, weights = weight, tau = probs, data = data)
stats <- as.numeric(stats::coef(mod))
} else {
stats <- as.numeric(quantile(data$y, probs = probs))
}
names(stats) <- c("ymin", "lower", "middle", "upper", "ymax")
df <- as.data.frame(as.list(stats))
if (is.null(data$weight)) {
n <- sum(!is.na(data$y))
} else {
# Sum up weights for non-NA positions of y and weight
n <- sum(data$weight[!is.na(data$y) & !is.na(data$weight)])
}
df$x <- if (is.factor(data$x)) data$x[1] else mean(range(data$x))
df$width <- width
df$relvarwidth <- sqrt(n)
df
}
)
# nolint end: object_name_linter
ggthemes/R/theme-foundation.R 0000644 0001762 0000144 00000002776 15112461554 015667 0 ustar ligges users #' Foundation Theme
#'
#' This theme is designed to be a foundation from which to build new
#' themes, and not meant to be used directly. \code{theme_foundation()}
#' is a complete theme with only minimal number of elements defined.
#' It is easier to create new themes by extending this one rather
#' than \code{\link[ggplot2]{theme_gray}()} or \code{\link[ggplot2]{theme_bw}()},
#' because those themes define elements deep in the hierarchy.
#'
#' This theme takes \code{\link[ggplot2]{theme_gray}()} and sets all
#' \code{colour} and \code{fill} values to \code{NULL}, except for the top-level
#' elements (\code{line}, \code{rect}, and \code{title}), which have
#' \code{colour = "black"}, and \code{fill = "white"}. This leaves the spacing
#' and-non colour defaults of the default \pkg{ggplot2} themes in place.
#'
#' @inheritParams ggplot2::theme_grey
#'
#' @family themes
#' @export
#' @importFrom ggplot2 theme_grey
theme_foundation <- function(base_size = 12, base_family = "") {
thm <- theme_grey(base_size = base_size, base_family = base_family)
for (i in names(thm)) {
if ("colour" %in% names(thm[[i]])) {
thm[[i]]["colour"] <- list(NULL)
}
if ("fill" %in% names(thm[[i]])) {
thm[[i]]["fill"] <- list(NULL)
}
}
thm +
theme(
panel.border = element_rect(fill = NA),
legend.background = element_rect(colour = NA),
line = element_line(colour = "black"),
rect = element_rect(fill = "white", colour = "black"),
text = element_text(colour = "black")
)
}
ggthemes/R/theme-solid.R 0000644 0001762 0000144 00000001330 15112461554 014614 0 ustar ligges users #' Theme with nothing other than a background color
#'
#' Theme that removes all non-geom elements (lines, text, etc),
#' This theme is when only the geometric objects are desired.
#'
#' @param base_size Base font size.
#' @param base_family Ignored, kept for consistency with \code{\link[ggplot2]{theme}()}.
#' @param fill Background color of the plot.
#' @family themes
#' @example inst/examples/ex-theme_solid.R
#' @export
theme_solid <- function(base_size = 12, base_family = "", fill = NA) {
theme_foundation() +
theme(
line = element_blank(),
text = element_blank(),
rect = element_rect(
fill = fill,
linewidth = base_size,
colour = NA,
linetype = 0
)
)
}
ggthemes/R/stata.R 0000644 0001762 0000144 00000031151 15112654506 013523 0 ustar ligges users #' Stata color palettes (discrete)
#'
#' Stata color palettes. See Stata documentation for a description of
#' the schemes, \url{https://www.stata.com/help.cgi?schemes}.
#'
#' All these palettes support up to 15 values.
#'
#' @param scheme \code{character}. One of \code{"s2color"},
#' \code{"s1rcolor"}, \code{"s1color"}, or \code{"mono"}.
#'
#' @export
#' @family stata colour
#' @example inst/examples/ex-stata_pal.R
stata_pal <- function(scheme = "s2color") {
colors <-
ggthemes::ggthemes_data[["stata"]][["colors"]][["schemes"]][[scheme]]
max_n <- length(colors)
f <- manual_pal(colors[["value"]])
attr(f, "max_n") <- max_n
f
}
#' Stata color scales
#'
#' See \code{\link{stata_pal}()} for details.
#'
#' @inheritParams stata_pal
#' @inheritParams ggplot2::scale_colour_hue
#' @family colour stata
#' @rdname scale_stata
#' @export
scale_colour_stata <- function(scheme = "s2color", ...) {
discrete_scale("colour", palette = stata_pal(scheme), ...)
}
#' @export
#' @rdname scale_stata
scale_fill_stata <- function(scheme = "s2color", ...) {
discrete_scale("fill", palette = stata_pal(scheme), ...)
}
#' @export
#' @rdname scale_stata
scale_color_stata <- scale_colour_stata
#' @importFrom ggplot2 margin
theme_stata_base <- function(base_size = 11, base_family = "sans") {
## Sizes
relsz <- sapply(as.numeric(stata_gsize), `/`, y = as.numeric(stata_gsize$medium))
names(relsz) <- names(stata_gsize)
theme_foundation() +
theme(
line = element_line(
linewidth = 0.5,
linetype = 1,
lineend = "butt",
colour = "black"
),
rect = element_rect(
linewidth = 0.5,
linetype = 1,
fill = "white",
colour = "black"
),
text = element_text(
family = base_family,
face = "plain",
colour = "black",
size = base_size,
hjust = 0.5,
vjust = 1,
angle = 0,
lineheight = 1,
margin = margin(),
debug = FALSE
),
title = element_text(),
## Axis
axis.line = element_line(),
axis.text = element_text(size = rel(relsz["medsmall"])),
axis.text.x = element_text(vjust = 1),
axis.text.y = element_text(angle = 90, vjust = 0.5),
## I cannot figure out how to get ggplot to do 2 levels of ticks
axis.ticks = element_line(),
axis.title = element_text(size = rel(relsz["medsmall"])),
axis.title.x = element_text(),
axis.title.y = element_text(angle = 90, vjust = 0),
# axis.ticks.length = stata_gsize$tiny,
# axis.ticks.margin = stata_gsize$half_tiny,
axis.ticks.length = unit(4 / 11, "lines"),
legend.background = element_rect(
linetype = 1,
linewidth = rel(stata_linewidths[["thin"]])
),
legend.spacing = unit(1.2 / 100, "npc"),
legend.key = element_rect(linetype = 0),
legend.key.size = unit(1.2, "lines"),
legend.key.height = NULL,
legend.key.width = NULL,
legend.text = element_text(size = rel(relsz["medsmall"])),
legend.text.align = NULL,
## See textboxstyle leg_title
legend.title = element_text(size = rel(relsz["large"]), hjust = 0.5),
legend.position = "bottom",
legend.direction = NULL,
legend.justification = "center",
legend.box = "vertical",
## plotregion
panel.background = element_rect(),
panel.border = element_blank(),
panel.grid.major = element_line(),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
panel.spacing = unit(0.25, "lines"),
## textboxstyle bytitle bytitle
strip.background = element_rect(linetype = 0),
strip.text = element_text(size = rel(relsz["medlarge"])),
strip.text.x = element_text(vjust = 0.5),
strip.text.y = element_text(angle = -90),
plot.background = element_rect(linetype = 0, colour = NA),
# Stata subtitle
plot.title = element_text(
size = rel(relsz["large"]),
hjust = 0.5,
vjust = 1
),
# Stata subtitle
plot.subtitle = element_text(
size = rel(relsz["medium"]),
hjust = 0.5,
vjust = 1
),
# Stata note
plot.caption = element_text(
size = rel(relsz["small"]),
hjust = 0,
vjust = 0
),
plot.margin = unit(rep(0.035, 4), "npc")
)
}
#' @importFrom tibble deframe
#' @importFrom stringr str_c
theme_stata_colors <- function(scheme = "s2color") {
stata_colors <- ggthemes::ggthemes_data[["stata"]][["colors"]][["names"]]
stata_colors <- deframe(stata_colors[, c("name", "value")])
schemes <- c(
"s2color",
"s2mono",
"s2manual",
"sj",
"s1color",
"s1rcolor",
"s1mono",
"s1manual"
)
if (scheme == "s2color") {
color_plot <- stata_colors["ltbluishgray"]
color_bg <- "white"
color_fg <- "black"
color_grid <- stata_colors["ltbluishgray"]
# color_grid_major <- stata_colors["ltbluishgray"]
fill_strip <- stata_colors["bluishgray"]
color_strip <- NA
color_title <- stata_colors["dknavy"]
color_border <- NA
legend_border <- "black"
} else if (scheme %in% c("s2mono", "s2manual", "sj")) {
color_plot <- stata_colors["gs15"]
color_bg <- "white"
color_fg <- "black"
color_grid <- stata_colors["dimgray"]
# color_grid_major <- stata_colors["dimgray"]
fill_strip <- stata_colors["gs13"]
color_strip <- NA
color_title <- "black"
color_border <- NA
legend_border <- "black"
} else if (scheme == "s1color") {
color_plot <- "white"
color_bg <- "white"
color_fg <- "black"
color_grid <- stata_colors["gs14"]
fill_strip <- stata_colors["ltkhaki"]
color_strip <- "black"
color_title <- "black"
color_border <- "black"
legend_border <- "black"
} else if (scheme == "s1rcolor") {
color_plot <- "black"
color_bg <- "black"
color_fg <- "white"
color_grid <- stata_colors["gs5"]
fill_strip <- stata_colors["maroon"]
color_strip <- "white"
color_title <- "white"
color_border <- "white"
legend_border <- "black"
} else if (scheme %in% c("s1mono", "s1manual")) {
color_plot <- "white"
color_bg <- "white"
color_fg <- "black"
color_grid <- stata_colors["gs14"]
fill_strip <- stata_colors["gs13"]
color_strip <- "black"
color_title <- "black"
color_border <- "black"
legend_border <- "black"
} else {
stop(str_c(
"`scheme` must be one of: ",
str_c(sort(schemes), collapse = ","),
", "
))
}
theme(
line = element_line(colour = color_fg, linetype = 1),
rect = element_rect(fill = color_bg, colour = color_fg, linetype = 1),
text = element_text(colour = color_fg),
title = element_text(colour = color_title),
axis.title = element_text(colour = color_fg),
axis.ticks.x = element_line(colour = color_fg),
axis.ticks.y = element_line(colour = color_fg),
axis.text.x = element_text(colour = color_fg),
axis.text.y = element_text(colour = color_fg),
legend.key = element_rect(fill = color_bg, colour = NA, linetype = 0),
legend.background = element_rect(
linetype = 1,
colour = legend_border
),
panel.background = element_rect(
fill = color_bg,
colour = color_border,
linetype = 1
),
panel.grid.major = element_line(colour = color_grid),
strip.background = element_rect(
fill = fill_strip,
colour = color_strip,
linetype = 1
),
plot.background = element_rect(fill = color_plot)
)
}
#' Themes based on Stata graph schemes
#'
#' @param scheme One of "s2color", "s2mono", "s1color",
#' "s1rcolor", or "s1mono", "s2manual",
#' "s1manual", or "sj"
#' @inheritParams ggplot2::theme_grey
#' @export
#' @family themes stata
#'
#' @details These themes approximate Stata schemes using the features
#' \pkg{ggplot2}. The graphical models of Stata and ggplot2 differ
#' in various ways that make an exact replication impossible (or
#' more difficult than it is worth).
#' Some features in Stata schemes not in ggplot2:
#' defaults for specific graph types, different levels of titles,
#' captions and notes. These themes also adopt some of the ggplot2
#' defaults, and more effort was made to match the colors and sizes
#' of major elements than in matching the margins.
#'
#' @references \url{https://www.stata.com/help.cgi?schemes}
#'
#' @example inst/examples/ex-theme_stata.R
theme_stata <- function(base_size = 11, base_family = "sans", scheme = "s2color") {
## Sizes
(theme_stata_base(base_size = eval(base_size), base_family = base_family) + theme_stata_colors(scheme = scheme))
}
#' Stata shape palette (discrete)
#'
#' Shape palette based on the symbol palette in Stata used in scheme s2mono.
#' This palette supports up to 10 values.
#'
#' @export
#' @family shapes stata
#' @seealso See \code{\link{scale_shape_stata}()} for examples.
#' @importFrom purrr map_dfr map
#' @importFrom tibble as_tibble
#' @importFrom stringr str_replace
stata_shape_pal <- function() {
## From s1mono, ignore small shapes
shapes <- c(
"circle",
"diamond",
"square",
"triangle",
"X",
"plus",
"circle_hollow",
"diamond_hollow",
"square_hollow",
"triangle_hollow"
)
statadata <- ggthemes::ggthemes_data[["stata"]][["shapes"]]
shapenames <- tibble::deframe(statadata[, c("symbolstyle", "unicode_value")])
values <- as.hexmode(str_replace(shapenames[shapes], "U\\+", ""))
values <- -as.integer(values)
out <- manual_pal(values)
attr(out, "max_n") <- length(shapes)
out
}
#' Stata shape scale
#'
#' See \code{\link{stata_shape_pal}()} for details.
#'
#' @inheritParams ggplot2::scale_x_discrete
#' @family shape stata
#' @export
#' @example inst/examples/ex-scale_shape_stata.R
#' @importFrom ggplot2 discrete_scale
scale_shape_stata <- function(...) {
discrete_scale("shape", palette = stata_shape_pal(), ...)
}
#' Stata linetype palette (discrete)
#'
#' Linetype palette based on the linepattern scheme in Stata.
#' This palette supports up to 15 values.
#'
#' @family linetype stata
#' @export
#' @seealso \code{\link{scale_linetype_stata}()}
stata_linetype_pal <- function() {
values <- ggthemes::ggthemes_data[["stata"]][["linetypes"]]
f <- function(n) {
values[seq_len(n)]
}
attr(f, "max_n") <- length(values)
f
}
#' Stata linetype palette (discrete)
#'
#' See \code{\link{stata_linetype_pal}()} for details.
#'
#' @inheritParams ggplot2::scale_x_discrete
#' @family linetype stata
#' @export
#' @example inst/examples/ex-scale_linetype_stata.R
scale_linetype_stata <- function(...) {
discrete_scale("linetype", palette = stata_linetype_pal(), ...)
}
## Text sizes (from style definitions ado/base/style/gsize-*.style)
stata_gsize <-
lapply(
c(
default = 4.1667,
full = 100,
half = 50,
half_tiny = 0.6944,
huge = 6.944,
large = 4.8611,
medium = 3.8194,
medlarge = 4.1667,
medsmall = 3.4722,
miniscule = 0.3472,
quarter = 25,
quarter_tiny = 0.34722,
small = 2.777,
tenth = 10,
third = 33.33333333333,
third_tiny = 0.46296,
tiny = 1.3888,
vhuge = 9.7222,
vlarge = 5.5556,
vsmall = 2.0833,
zero = 0
) /
100,
unit,
units = "npc"
)
# Line width styles ado/base/style/linewidth-*.style
# original values in npc * 100
# provide this in terms of relative values to medium
stata_linewidths <-
c(
medium = 0.3,
medthick = 0.45,
medthin = 0.25,
none = 0,
thick = 0.8,
thin = 0.2,
vthick = 1.4,
thin = 0.15,
vvthick = 2.6,
vvthin = 0.01,
vvvthick = 4.2,
vvvthin = .000001
) /
0.3
# Stata margin styles
# From ado/base/style/margin-*.style
stata_margins <- list(
bargraph = c(3.5, 3.5, 3.5, 0),
bottom = c(0, 0, 0, 3),
ebargraph = c(1.5, 1.5, 1.5, 0),
esubhead = c(2.2, 2.2, 0, 4),
horiz_bargraph = c(0, 3.5, 3.5, 3.5),
large = c(8, 8, 8, 8),
left = c(3, 0, 0, 0),
medium = c(3.5, 3.5, 3.5, 3.5),
medlarge = c(5, 5, 5, 5),
medsmall = c(2.2, 2.2, 2.2, 2.2),
right = c(0, 3, 0, 0),
sides = c(3.5, 3.5, 0, 0),
small = rep(1.2, 4),
tiny = rep(0.3, 4),
top_bottom = c(0, 0, 3.5, 3.5),
top = c(0, 0, 3, 0),
vlarge = rep(12, 4),
vsmall = rep(0.6, 4),
zero = rep(0, 4)
)
# s1mono line
# linepattern p1line solid
# linepattern p2line dash
# linepattern p3line vshortdash
# linepattern p4line longdash_dot
# linepattern p5line longdash
# linepattern p6line dash_dot
# linepattern p7line dot
# linepattern p8line shortdash_dot
# linepattern p9line tight_dot
# linepattern p10line dash_dot_dot
# linepattern p11line longdash_shortdash
# linepattern p12line dash_3dot
# linepattern p13line longdash_dot_dot
# linepattern p14line shortdash_dot_dot
# linepattern p15line longdash_3dot
ggthemes/R/shapes.R 0000644 0001762 0000144 00000014000 15112654506 013664 0 ustar ligges users # nolint start
#' Shape palette from Cleveland "Elements of Graphing Data" (discrete).
#'
#' Shape palettes for overlapping and non-overlapping points.
#'
#' @param overlap \code{logical} Use the scale for overlapping points?
#'
#' @note
#'
#' In the \emph{Elements of Graphing Data}, W.S. Cleveland suggests
#' two shape palettes for scatter plots: one for overlapping data and
#' another for non-overlapping data. The symbols for overlapping data
#' relies on pattern discrimination, while the symbols for
#' non-overlapping data vary the amount of fill. This palette
#' attempts to create these palettes. However, I found that these
#' were hard to replicate. Using the R shapes and unicode fonts: the
#' symbols can vary in size, they are dependent of the fonts used,
#' and there does not exist a unicode symbol for a circle with a
#' vertical line. If someone can improve this palette, please let me
#' know.
#'
#' Following Tremmel (1995), I replace the circle with a vertical
#' line with an encircled plus sign.
#'
#' The palette \code{cleveland_shape_pal()} supports up to five values.
#'
#' @example inst/examples/ex-cleveland_shape_pal.R
#' @references
#' Cleveland WS. \emph{The Elements of Graphing Data}. Revised Edition. Hobart Press, Summit, NJ, 1994, pp. 154-164, 234-239.
#'
#' Tremmel, Lothar, (1995) "The Visual Separability of Plotting Symbols in Scatterplots", \emph{Journal of Computational and Graphical Statistics},
#' \url{https://www.jstor.org/stable/1390760}
#'
#' @family shapes
#' @export
# nolint end
cleveland_shape_pal <- function(overlap = TRUE) {
shapes <- if (overlap[[1]]) {
ggthemes::ggthemes_data$shapes$cleveland$overlap$pch
} else {
ggthemes::ggthemes_data$shapes$cleveland$default$pch
}
max_n <- length(shapes)
f <- manual_pal(shapes)
attr(f, "max_n") <- max_n
f
}
#' Shape scales from Cleveland "Elements of Graphing Data"
#'
#' @inheritParams ggplot2::scale_x_discrete
#' @inheritParams cleveland_shape_pal
#' @export
#'
#' @family shapes
#' @seealso \code{\link{cleveland_shape_pal}()} for a description of the palette.
#' @references
#' Cleveland WS. The Elements of Graphing Data. Revised Edition.
#' Hobart Press, Summit, NJ, 1994, pp. 154-164, 234-239.
#'
scale_shape_cleveland <- function(overlap = TRUE, ...) {
discrete_scale("shape", palette = cleveland_shape_pal(overlap), ...)
}
#' Filled Circle Shape palette (discrete)
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated because unicode glyphs used for the circles
#' vary in size, making them unusable for plotting.
#'
#' Shape palette with circles varying by amount of fill. This uses
#' the set of 3 circle fill values in Lewandowsky and Spence (1989):
#' solid, hollow, half-filled, with two additional fill amounts:
#' three-quarters, and one-quarter.
#'
#' This palette supports up to five values.
#'
#' @references
#' Lewandowsky, Stephan and Ian Spence (1989)
#' "Discriminating Strata in Scatterplots", Journal of
#' the American Statistical Association, \url{https://www.jstor.org/stable/2289649}
#' @family shapes
#' @importFrom lifecycle deprecate_soft
#' @export
circlefill_shape_pal <- function() {
deprecate_soft("5.0.0", "circlefill_shape_pal()")
values <- ggthemes::ggthemes_data[["shapes"]][["circlefill"]][["pch"]]
max_n <- length(values)
f <- manual_pal(values)
attr(f, "max_n") <- max_n
f
}
#' Filled Circle Shape palette (discrete)
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' @export
#'
#' @inheritParams ggplot2::scale_x_discrete
#' @family shapes
#' @importFrom lifecycle deprecate_soft
#' @seealso
#' \code{\link{circlefill_shape_pal}()} for a description of the palette.
scale_shape_circlefill <- function(...) {
deprecate_soft("5.0.0", "scale_shape_circlefill()")
discrete_scale("shape", palette = circlefill_shape_pal(), ...)
}
#' Shape palette from Tremmel (1995) (discrete)
#'
#' Based on experiments Tremmel (1995) suggests the following shape palettes:
#'
#' If two symbols, then use a solid circle and plus sign.
#'
#' If three symbols, then use a solid circle, empty circle, and an
#' empty triangle. However, that set of symbols does not satisfy the
#' requirement that each symbol should differ from the other symbols
#' in the same feature dimension. A set of three symbols that
#' satisfies this is a circle (curvature), plus sign (number of
#' terminators), triangle (line orientation).
#'
#' This palette supports up to three values.
#' If more than three groups of data, then separate the groups into
#' different plots.
#'
#' @param overlap use an empty circle instead of a solid circle when
#' \code{n == 2}.
#' @param alt If \code{TRUE}, then when \code{n == 3},
#' use a solid circle, plus sign and
#' empty triangle. Otherwise use a solid circle, empty circle, and empty
#' triangle.
#' @family shapes
#' @references
#' Tremmel, Lothar, (1995) "The Visual Separability of Plotting Symbols in Scatterplots"
#' Journal of Computational and Graphical Statistics,
#' \url{https://www.jstor.org/stable/1390760}
#' @export
tremmel_shape_pal <- function(overlap = FALSE, alt = FALSE) {
max_n <- 3L
palettes <- ggthemes::ggthemes_data$shapes$tremmel
f <- function(n) {
check_pal_n(n, max_n)
if (n == 1) {
palettes[["1"]]$pch
} else if (n == 2) {
if (overlap[[1]]) {
palettes[["2-overlap"]]$pch
} else {
palettes[["2"]]$pch
}
} else if (n >= 3) {
out <- rep(NA_integer_, n)
out[1:3] <- if (alt) {
palettes[["3-alternate"]]$pch
} else {
palettes[["3"]]$pch
}
out
}
}
attr(f, "max_n") <- max_n
f
}
#' Shape scales from Tremmel (1995)
#'
#' @inheritParams ggplot2::scale_x_discrete
#' @inheritParams tremmel_shape_pal
#'
#' @seealso \code{\link{tremmel_shape_pal}()} for a description of the palette.
#' @example inst/examples/ex-scale_shape_tremmel.R
#' @family shapes
#' @export
scale_shape_tremmel <- function(overlap = FALSE, alt = TRUE, ...) {
discrete_scale(
"shape",
palette = tremmel_shape_pal(
overlap = overlap,
alt = alt
),
...
)
}
ggthemes/R/banking.R 0000644 0001762 0000144 00000007664 15112461554 014033 0 ustar ligges users ## 45 degrees in radians
FORTY_FIVE <- base::pi / 4 # nolint: object_name_linter
calc_slopes <- function(x, y, cull = FALSE) {
dx <- abs(diff(x))
dy <- diff(y)
s <- dy / dx
touse <- if (cull) {
abs(s) > 0 & is.finite(s)
} else {
is.finite(s)
}
list(
s = s[touse],
dx = dx[touse],
dy = dy[touse],
Rx = diff(range(x)),
Ry = diff(range(y))
)
}
#' Bank Slopes to 45 degrees
#'
#' Calculate the optimal aspect ratio of a line graph by banking the
#' slopes to 45 degrees as suggested by W.S. Cleveland. This
#' maximizes the ability to visually differentiate differences in
#' slope. This function will calculate the optimal aspect ratio for
#' a line plot using any of the methods described in Herr and Argwala
#' (2006). In their review of the methods they suggest using median
#' absolute slope banking ('ms'), which produces aspect ratios which
#' are generally the median of the various methods provided here.
#'
#' @param x x values
#' @param y y values
#' @param cull \code{logical}. Remove all slopes of 0 or \code{Inf}.
#' @param method One of 'ms' (Median Absolute Slope) or 'as' (Average
#' Absolute Slope). Other options are no longer supported, and will use
#' 'ms' instead with a warning.
#' @param weight No longer used, but kept for backwards compatibility.
#' @param ... No longer used, but kept for backwards compatibility.
#'
#' @section Methods:
#'
#' As written, all of these methods calculate the aspect ratio (x
#' /y), but \code{bank_slopes} will return (y / x) to be compatible
#' with \code{link[ggplot2]{coord_fixed()}}.
#'
#' \strong{Median Absolute Slopes Banking}
#'
#' Let the aspect ratio be \eqn{\alpha = \frac{w}{h}}{alpha = w / h}
#' then the median absolute slop banking is the
#' \eqn{\alpha}{alpha} such that,
#' \deqn{
#' median \left| \frac{s_i}{\alpha} \right| = 1
#' }{
#' median |s_i / alpha|
#' }
#'
#' Let \eqn{R_z = z_{max} - z_{min}}{R_z = z_max - z_min} for \eqn{z = x, y},
#' and \eqn{M = median \| s_i \|}{M = median | s_i |}. Then,
#' \deqn{
#' \alpha = M \frac{R_x}{R_y}
#' }{
#' alpha = M R_x / R_y
#' }
#'
#' \strong{Average Absolute Slope Banking}
#'
#' Let the aspect ratio be \eqn{\alpha = \frac{w}{h}}{alpha = w/h}.
#' then the mean absolute slope banking is the
#' \eqn{\alpha}{alpha} such that,
#' \deqn{
#' mean \left| \frac{s_i}{\alpha} \right| = 1
#' }{
#' mean |s_i / alpha| = 1
#' }
#'
#' Heer and Agrawala (2006) and Cleveland discuss several other methods
#' including average (weighted) orientation, and global and local orientation resolution.
#' These are no longer implemented in this function. In general, either the
#' median or average absolute slopes will produce reasonable results without
#' requiring optimization.
#'
#' @references
#' Cleveland, W. S., M. E. McGill, and R. McGill. The Shape Parameter
#' of a Two-Variable Graph. Journal of the American Statistical
#' Association, 83:289-300, 1988
#'
#' Heer, Jeffrey and Maneesh Agrawala, 2006. 'Multi-Scale Banking to 45'
#' IEEE Transactions On Visualization And Computer Graphics.
#'
#' Cleveland, W. S. 1993. 'A Model for Studying Display Methods of Statistical
#' Graphs.' Journal of Computational and Statistical Graphics.
#'
#' Cleveland, W. S. 1994. The Elements of Graphing Data, Revised Edition.
#'
#' @return \code{numeric} The aspect ratio (x , y).
#'
#' @seealso \code{\link[lattice]{banking}()}
#' @export
#' @example inst/examples/ex-bank_slopes.R
bank_slopes <- function(x, y, cull = FALSE, weight = NULL, method = c("ms", "as"), ...) {
method <- match.arg(method)
fun <- bank_slopes_funs[[method]]
# Heer produces functions with the target alpha = w/h = x/y
xyrat <- fun(calc_slopes(x, y, cull = cull), ...)
# but coord_fixed ratio is the aspect ratio y/x
1 / xyrat
}
bank_slopes_funs <- list()
bank_slopes_funs[["ms"]] <-
function(slopes, ...) {
median(abs(slopes$s)) * slopes$Rx / slopes$Ry
}
bank_slopes_funs[["as"]] <-
function(slopes, ...) {
mean(abs(slopes$s)) * slopes$Rx / slopes$Ry
}
ggthemes/R/pander.R 0000644 0001762 0000144 00000017677 15112654506 013701 0 ustar ligges users #' A ggplot theme originated from the pander package
#'
#' The \pkg{pander} ships with a default theme when the 'unify plots' option is
#' enabled via \code{panderOptions}, which is now also available outside of \pkg{pander} internals, like \code{evals},
#' \code{eval.msgs} or \code{Pandoc.brew}.
#' @inheritParams ggplot2::theme_bw
#' @param nomargin suppress the white space around the plot (boolean)
#' @param ff font family, like \code{sans}. Deprecated: use \code{base_family} instead.
#' @param fc font color (name or hexa code)
#' @param fs font size (integer). Deprecated: use \code{base_size} instead.
#' @param gM major grid (boolean)
#' @param gm minor grid (boolean)
#' @param gc grid color (name or hexa code)
#' @param gl grid line type (\code{lty})
#' @param boxes to render a border around the plot or not
#' @param bc background color (name or hexa code)
#' @param pc panel background color (name or hexa code)
#' @param lp legend position
#' @param axis axis angle as defined in \code{par(les)}
#' @export
#' @example inst/examples/ex-theme_pander.R
theme_pander <- function(
base_size = 12, # nolint: cyclocomp_linter
base_family = "sans",
nomargin = TRUE,
ff = NULL,
fc = "black",
fs = NULL,
gM = TRUE, # nolint: object_name_linter
gm = TRUE,
gc = "grey",
gl = "dashed",
boxes = FALSE,
bc = "white",
pc = "transparent",
lp = "right",
axis = 1
) {
if (hasArg(ff)) {
base_family <- ff
warning("Argument `ff` deprecated. Use `base_family` instead.")
}
if (hasArg(fs)) {
base_size <- fs
warning("Argument `fs` deprecated. Use `base_size` instead.")
}
if (requireNamespace("pander", quietly = TRUE)) {
if (missing(nomargin)) {
nomargin <- pander::panderOptions("graph.nomargin")
}
if (missing(base_family)) {
base_family <- pander::panderOptions("graph.fontfamily")
}
if (missing(fc)) {
fc <- pander::panderOptions("graph.fontcolor")
}
if (missing(base_size)) {
base_size <- pander::panderOptions("graph.fontsize")
}
if (missing(gM)) {
gM <- pander::panderOptions("graph.grid") # nolint: object_name_linter
}
if (missing(gm)) {
gm <- pander::panderOptions("graph.grid.minor")
}
if (missing(gc)) {
gc <- pander::panderOptions("graph.grid.color")
}
if (missing(gl)) {
gl <- pander::panderOptions("graph.grid.lty")
}
if (missing(boxes)) {
boxes <- pander::panderOptions("graph.boxes")
}
if (missing(bc)) {
bc <- pander::panderOptions("graph.background")
}
if (missing(pc)) {
pc <- pander::panderOptions("graph.panel.background")
}
if (missing(lp)) {
lp <- pander::panderOptions("graph.legend.position")
}
if (missing(axis)) {
axis <- pander::panderOptions("graph.axis.angle")
}
}
## DRY
tc <- ifelse(pc == "transparent", bc, pc) # 'transparent' color
## default colors, font and legend position
res <- theme(
text = element_text(family = base_family),
plot.background = element_rect(fill = bc, colour = NA),
panel.grid = element_line(
colour = gc,
linewidth = 0.2,
linetype = gl
),
panel.grid.minor = element_line(linewidth = 0.1),
axis.ticks = element_line(
colour = gc,
linewidth = 0.2
),
plot.title = element_text(
colour = fc,
face = "bold",
size = base_size * 1.2
),
axis.text = element_text(
colour = fc,
face = "plain",
size = base_size * 0.8
),
legend.text = element_text(
colour = fc,
face = "plain",
size = base_size * 0.8
),
legend.title = element_text(
colour = fc,
face = "italic",
size = base_size
),
axis.title.x = element_text(
colour = fc,
face = "plain",
size = base_size
),
strip.text.x = element_text(
colour = fc,
face = "plain",
size = base_size
),
axis.title.y = element_text(
colour = fc,
face = "plain",
size = base_size,
angle = 90
),
strip.text.y = element_text(
colour = fc,
face = "plain",
size = base_size,
angle = -90
),
legend.key = element_rect(colour = gc, fill = "transparent"),
strip.background = element_rect(
colour = gc,
fill = "transparent"
),
panel.border = element_rect(fill = NA, colour = gc),
panel.background = element_rect(fill = pc, colour = gc),
legend.position = lp
)
## disable box(es) around the plot
if (!isTRUE(boxes)) {
res <- res +
theme(
legend.key = element_rect(
colour = "transparent",
fill = "transparent"
),
strip.background = element_rect(
colour = "transparent",
fill = "transparent"
),
panel.border = element_rect(
fill = NA,
colour = tc
),
panel.background = element_rect(
fill = pc,
colour = tc
)
)
}
## disable grid
if (!isTRUE(gM)) {
res <- res +
theme(
panel.grid = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
)
}
## disable minor grid
if (!isTRUE(gm)) {
res <- res + theme(panel.grid.minor = element_blank())
}
## margin
if (nomargin) {
res <- res + theme(plot.margin = unit(c(0.1, 0.1, 0.1, 0), "lines"))
}
## axis angle (TODO: DRY with ifelse in the default color etc. section)
if (axis == 0) {
res <- res +
theme(
axis.text.y = element_text(
colour = fc,
family = base_family,
face = "plain",
size = base_size * 0.8,
angle = 90
)
)
}
if (axis == 2) {
res <- res +
theme(
axis.text.x = element_text(
colour = fc,
family = base_family,
face = "plain",
size = base_size * 0.8,
angle = 90,
hjust = 1
)
)
}
if (axis == 3) {
res <- res +
theme(
axis.text.y = element_text(
colour = fc,
family = base_family,
face = "plain",
size = base_size * 0.8,
angle = 90
),
axis.text.x = element_text(
colour = fc,
family = base_family,
face = "plain",
size = base_size * 0.8,
angle = 90,
hjust = 1
)
)
}
res
}
#' Color palette from the pander package
#'
#' The \pkg{pander} ships with a default colorblind and printer-friendly
#' color palette borrowed from \verb{https://jfly.iam.u-tokyo.ac.jp/color/}.
#'
#' @param n number of colors. This palette supports up to eight colors.
#' @param random_order if the palette should be reordered randomly before
#' rendering each plot to get colorful images
#' @export
#' @family colour pander
#' @example inst/examples/ex-palette_pander.R
palette_pander <- function(n, random_order = FALSE) {
## default (colorblind and printer-friendly) colors
cols <- c(
"#56B4E9",
"#009E73",
"#F0E442",
"#0072B2",
"#D55E00",
"#CC79A7",
"#999999",
"#E69F00"
)
if (requireNamespace("pander", quietly = TRUE)) {
cols <- pander::panderOptions("graph.colors")
}
if (isTRUE(random_order)) {
cols <- sample(cols)
}
if (length(cols) < n) {
cols <- rep(cols, length.out = n)
}
cols[1:n]
}
#' Color scale from the pander package
#'
#' The \pkg{pander} ships with a default colorblind and printer-friendly color
#' palette borrowed from \verb{https://jfly.iam.u-tokyo.ac.jp/color/}.
#' @inheritParams ggplot2::scale_colour_hue
#' @inheritParams palette_pander
#' @family colour pander
#' @rdname scale_pander
#' @seealso \code{\link{theme_pander}()}
#' @export
scale_color_pander <- function(...) {
discrete_scale("colour", palette = palette_pander, ...)
}
#' @rdname scale_pander
#' @export
scale_colour_pander <- scale_color_pander
#' @rdname scale_pander
#' @export
scale_fill_pander <- function(...) {
discrete_scale("fill", palette = palette_pander, ...)
}
ggthemes/R/calc.R 0000644 0001762 0000144 00000010301 15112654506 013303 0 ustar ligges users #' Theme Calc
#'
#' Theme similar to the default settings of LibreOffice Calc charts.
#'
#' @inheritParams ggplot2::theme_grey
#' @export
#' @family themes calc
#' @example inst/examples/ex-theme_calc.R
theme_calc <- function(base_size = 10, base_family = "sans") {
(theme_foundation(base_family = base_family, base_size = base_size) +
theme(
rect = element_rect(colour = "black", fill = "white"),
text = element_text(colour = "black"),
line = element_line(colour = "gray70"),
# 13 pt
plot.title = element_text(size = rel(1.3)),
legend.title = element_text(size = rel(1)),
legend.text = element_text(size = rel(1)),
axis.title = element_text(size = rel(1)),
axis.line = element_blank(),
panel.border = element_rect(fill = NA, colour = "gray70"),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
legend.position = "right",
legend.direction = "vertical",
legend.background = element_rect(colour = NA),
legend.key = element_rect(colour = NA)
))
}
#' Calc color palette (discrete)
#'
#' Color palettes from LibreOffice Calc.
#' This palette has 12 values.
#'
#' @family colour calc
#' @export
#' @example inst/examples/ex-calc_pal.R
calc_pal <- function() {
values <- unname(ggthemes::ggthemes_data$calc$colors[["value"]])
max_n <- length(values)
f <- manual_pal(values)
attr(f, "max_n") <- max_n
f
}
#' LibreOffice Calc color scales
#'
#' Color scales from LibreOffice Calc.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @family colour calc
#' @rdname scale_calc
#' @export
#' @seealso See \code{\link{theme_calc}()} for examples.
scale_fill_calc <- function(...) {
discrete_scale("fill", palette = calc_pal(), ...)
}
#' @export
#' @rdname scale_calc
scale_colour_calc <- function(...) {
discrete_scale("colour", palette = calc_pal(), ...)
}
#' @export
#' @rdname scale_calc
scale_color_calc <- scale_colour_calc
#' Calc shape palette (discrete)
#'
#' Shape palette based on the shapes used in LibreOffice Calc.
#'
#' @export
#' @family shapes calc
#' @example inst/examples/ex-calc_shape_pal.R
calc_shape_pal <- function() {
values <- ggthemes::ggthemes_data$calc$shapes[["pch"]]
f <- manual_pal(unname(values))
attr(f, "max_n") <- length(values)
f
}
#' Calc shape scale
#'
#' See \code{\link{calc_shape_pal}()} for details.
#'
#' @inheritParams ggplot2::scale_x_discrete
#' @family shapes calc
#' @export
#' @seealso \code{\link{theme_calc}()} for examples.
scale_shape_calc <- function(...) {
discrete_scale("shape", palette = calc_shape_pal(), ...)
}
# PT_TO_MM <- 0.352778
#
# # Default font is Liberation Sans
# theme_libre <- function(base_size = 10,
# base_family = "sans") {
# colorlist <- list(gray = "#B3B3B3")
# theme_bw(base_family = base_family,
# base_size = base_size) +
# theme(
# text = element_text(colour = "black"),
# line = element_line(
# linetype = "solid",
# colour = colorlist$gray,
# size = 0.5 * PT_TO_MM
# ),
# rect = element_rect(
# fill = "white",
# linetype = "solid",
# colour = colorlist$gray,
# size = 0.5 * PT_TO_MM
# ),
# panel.grid.major = element_line(
# linetype = "solid",
# colour = colorlist$gray,
# size = 0.5 * PT_TO_MM
# ),
# axis.title = element_text(
# size = 9
# ),
# axis.text = element_text(
# size = 10
# ),
# axis.ticks = element_line(
# colour = colorlist$gray
# ),
# panel.background = element_rect(
# colour = colorlist$gray,
# size = 0.5 * PT_TO_MM
# ),
# title = element_text(
# face = "plain",
# hjust = 0.5
# ),
# plot.title = element_text(
# size = 13,
# hjust = 0.5
# ),
# plot.subtitle = element_text(
# size = 11,
# hjust = 0.5
# ),
# panel.grid.major.x = element_blank(),
# panel.grid.minor = element_blank(),
# legend.position = "right",
# strip.background = element_blank(),
# strip.text = element_text(size = 9),
# legend.title = element_text(
# size = 9
# )
# )
# }
ggthemes/R/solarized.R 0000644 0001762 0000144 00000012670 15112654506 014410 0 ustar ligges users #' Base colors for Solarized light and dark themes
#'
#' @param light \code{logical} Light theme?
#'
#' Creates the base colors for a light or dark solarized theme. See
#' \url{https://ethanschoonover.com/solarized/}. This function is a port
#' of the CSS style example.
#'
#' @keywords internal
solarized_rebase <- function(light = TRUE) {
basecolors <- deframe(ggthemes::ggthemes_data$solarized$Base)
rebase <- if (light) {
basecolors[c(paste0("base", 3:0), paste0("base0", 0:3))]
} else {
basecolors[c(paste0("base0", 3:0), paste0("base", 0:3))]
}
names(rebase) <- paste0("rebase", c(paste0("0", 3:0), 0:3))
rebase
}
solarized_accent_list <- function() {
paste0("\\code{\"", names(ggthemes::ggthemes_data$solarized$Accents), "\"}", collapse = ",")
}
#' Solarized color palette (discrete)
#'
#' Qualitative color palate based on the Ethan Schoonover's Solarized
#' palette, \url{https://ethanschoonover.com/solarized/}. This palette supports
#' up to seven values.
#'
#' @note
#'
#' For a given starting color and number of colors in the palette,
#' the other colors are the combination of colors that maximizes the
#' total Euclidean distance between colors in L*a*b space.
#'
#' @param accent \code{character} Starting color.
#' @export
#' @family solarized colour
#' @example inst/examples/ex-solarized_pal.R
solarized_pal <- function(accent = "blue") {
palettes <- ggthemes::ggthemes_data[["solarized"]][["palettes"]][[accent]]
max_n <- length(palettes)
f <- function(n) {
check_pal_n(n, max_n)
palettes[[n]]
}
attr(f, "max_n") <- f
f
}
#' Solarized color scales
#'
#' See \code{\link{solarized_pal}()} for details.
#'
#' @inheritParams ggplot2::scale_colour_hue
#' @inheritParams solarized_pal
#' @family colour scales
#' @rdname scale_solarized
#' @family solarized colour
#' @export
#' @example inst/examples/ex-scale_solarized.R
scale_fill_solarized <- function(accent = "blue", ...) {
discrete_scale("fill", palette = solarized_pal(accent), ...)
}
#' @export
#' @rdname scale_solarized
scale_colour_solarized <- function(accent = "blue", ...) {
discrete_scale("colour", palette = solarized_pal(accent), ...)
}
#' @export
#' @rdname scale_solarized
scale_color_solarized <- scale_colour_solarized
#' ggplot color themes based on the Solarized palette
#'
#' See \url{https://ethanschoonover.com/solarized/} for a
#' description of the Solarized palette.
#'
#' Plots made with this theme integrate seamlessly with the Solarized
#' Beamer color theme.
#' \url{https://github.com/jrnold/beamercolorthemesolarized}.
#' There are two variations: \code{theme_solarized} is similar to
#' to \code{\link[ggplot2]{theme_bw}()}, while \code{theme_solarized_2()} is
#' similar to \code{\link[ggplot2]{theme_gray}()}.
#'
#' @rdname theme_solarized
#' @inheritParams ggplot2::theme_grey
#' @param light \code{logical}. Light or dark theme?
#' @export
#' @family themes solarized
#' @example inst/examples/ex-theme_solarized.R
theme_solarized <- function(base_size = 12, base_family = "", light = TRUE) {
rebase <- solarized_rebase(light)
ret <- (theme_bw(base_size = base_size, base_family = base_family) +
theme(
text = element_text(colour = rebase["rebase01"]),
title = element_text(color = rebase["rebase0"]),
line = element_line(color = rebase["rebase01"]),
rect = element_rect(
fill = rebase["rebase03"],
color = rebase["rebase01"]
),
axis.ticks = element_line(color = rebase["rebase01"]),
axis.line = element_line(
color = rebase["rebase01"],
linetype = 1
),
legend.background = element_rect(fill = NULL, color = NA),
legend.key = element_blank(),
panel.background = element_rect(
fill = rebase["rebase03"],
colour = rebase["rebase01"]
),
panel.border = element_blank(),
panel.grid = element_line(color = rebase["rebase02"]),
panel.grid.major = element_line(color = rebase["rebase02"]),
panel.grid.minor = element_line(color = rebase["rebase02"]),
plot.background = element_rect(
fill = NULL,
colour = NA,
linetype = 0
)
))
ret
}
#' @rdname theme_solarized
#' @export
theme_solarized_2 <- function(base_size = 12, base_family = "", light = TRUE) {
rebase <- solarized_rebase(light)
ret <- (theme_foundation(base_size = base_size, base_family = base_family) +
theme(
text = element_text(color = rebase["rebase01"]),
title = element_text(color = rebase["rebase0"]),
line = element_line(color = rebase["rebase01"]),
rect = element_rect(
fill = rebase["rebase03"],
color = NA
),
axis.ticks = element_line(color = rebase["rebase01"]),
axis.line = element_line(
color = rebase["reabase01"],
linetype = 1
),
axis.title.y = element_text(angle = 90),
legend.background = element_rect(fill = NULL, color = NA),
legend.key = element_rect(
fill = NULL,
colour = NULL,
linetype = 0
),
panel.background = element_rect(
fill = rebase["rebase02"],
colour = NA
),
panel.border = element_blank(),
panel.grid = element_line(color = rebase["rebase03"]),
panel.grid.major = element_line(color = rebase["rebase03"]),
panel.grid.minor = element_line(
color = rebase["rebase03"],
linewidth = 0.25
),
plot.background = element_rect(
fill = NULL,
colour = NULL,
linetype = 0
)
))
ret
}
ggthemes/R/clean.R 0000644 0001762 0000144 00000003574 15112676746 013513 0 ustar ligges users #' @title Clean ggplot theme
#'
#' @description Clean ggplot theme with no panel background, black axis lines
#' and grey fill colour for chart elements.
#'
#' @author Konrad Zdeb \email{name.surname@@me.com}
#'
#' @param base_size Base font size.
#' @param base_family Base font family.
#'
#' @family themes
#' @export
#'
#' @example inst/examples/ex-theme_clean.R
theme_clean <- function(base_size = 12, base_family = "sans") {
(theme_foundation(
base_size = base_size,
base_family = base_family
) +
theme(
axis.line.x = element_line(
colour = "black",
linewidth = 0.5,
linetype = "solid"
),
axis.line.y = element_line(
colour = "black",
linewidth = 0.5,
linetype = "solid"
),
axis.text = element_text(size = ceiling(base_size * 0.7), colour = "black"),
axis.title = element_text(size = ceiling(base_size * 0.8)),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_line(colour = "gray", linetype = "dotted"),
panel.grid.major.x = element_blank(),
panel.background = element_blank(),
panel.border = element_blank(),
strip.background = element_rect(linetype = 0),
strip.text = element_text(),
strip.text.x = element_text(vjust = 0.5),
strip.text.y = element_text(angle = -90),
legend.text = element_text(size = ceiling(base_size * 0.9), family = "sans"),
legend.title = element_text(
size = base_size,
face = "bold",
family = "sans"
),
legend.position = "right",
legend.key = element_rect(fill = "white", colour = NA),
legend.background = element_rect(colour = "black"),
plot.background = element_rect(colour = "black"),
plot.title = element_text(size = ceiling(base_size * 1.1), face = "bold"),
plot.subtitle = element_text(size = ceiling(base_size * 1.05))
))
}
ggthemes/R/theme-map.R 0000644 0001762 0000144 00000001444 15112366564 014272 0 ustar ligges users #' Clean theme for maps
#'
#' A clean theme that is good for displaying maps from
#' \code{\link[ggplot2]{geom_map}()}.
#'
#' @inheritParams ggplot2::theme_grey
#' @example inst/examples/ex-theme_map.R
#' @export
#' @importFrom ggplot2 %+replace%
theme_map <- function(base_size = 9, base_family = "") {
theme_bw(base_size = base_size, base_family = base_family) %+replace%
theme(
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.background = element_blank(),
panel.border = element_blank(),
panel.grid = element_blank(),
panel.spacing = unit(0, "lines"),
plot.background = element_blank(),
legend.justification = c(0, 0),
legend.position = c(0, 0)
)
}
ggthemes/R/scales.R 0000644 0001762 0000144 00000015160 15112461554 013662 0 ustar ligges users # Much of this code is copied from the labeling package.
# nolint start: object_name_linter
.simplicity <- function(q, Q, j, lmin, lmax, lstep) {
eps <- .Machine$double.eps * 100
n <- length(Q)
i <- match(q, Q)[1]
v <- ifelse(
(lmin %% lstep < eps ||
lstep - (lmin %% lstep) < eps) &&
lmin <= 0 &&
lmax >= 0,
1,
0
)
1 - (i - 1) / (n - 1) - j + v
}
.simplicity_max <- function(q, Q, j) {
n <- length(Q)
i <- match(q, Q)[1]
v <- 1
1 - (i - 1) / (n - 1) - j + v
}
.coverage <- function(dmin, dmax, lmin, lmax) {
range <- dmax - dmin
1 - 0.5 * ((dmax - lmax)^2 + (dmin - lmin)^2) / ((0.1 * range)^2)
}
.coverage_max <- function(dmin, dmax, span) {
range <- dmax - dmin
if (span > range) {
half <- (span - range) / 2
1 - 0.5 * (half^2 + half^2) / ((0.1 * range)^2)
} else {
1
}
}
.density <- function(k, m, dmin, dmax, lmin, lmax) {
r <- (k - 1) / (lmax - lmin)
rt <- (m - 1) / (max(lmax, dmax) - min(dmin, lmin))
2 - max(r / rt, rt / r)
}
.density_max <- function(k, m) {
if (k >= m) {
2 - (k - 1) / (m - 1)
} else {
1
}
}
.legibility <- function(lmin, lmax, lstep) {
1
}
#' Pretty axis breaks inclusive of extreme values
#'
#' This function returns pretty axis breaks that always include the extreme values of the data.
#' This works by calling the extended Wilkinson algorithm (Talbot et al., 2010), constrained to solutions
#' interior to the data range.
#' Then, the minimum and maximum labels are moved to the minimum and maximum of the data
#' range.
#'
#' \code{extended_range_breaks} implements the algorithm and returns the break values.
#' \code{scales_extended_range_breaks} uses the conventions of the \pkg{scales} package, and returns a function.
#'
#' @param dmin minimum of the data range
#' @param dmax maximum of the data range
#' @param n desired number of breaks
#' @param Q set of nice numbers
#' @param w weights applied to the four optimization components (simplicity, coverage, density, and legibility)
#' @return For \code{extended_range_breaks}, the vector of axis label locations.
#' For \code{scales_extended_range_breaks}, a function which takes a single argument, a vector of data, and returns
#' the vector of axis label locations.
#' @references
#' Talbot, J., Lin, S., Hanrahan, P. (2010) An Extension of Wilkinson's Algorithm
#' for Positioning Tick Labels on Axes, InfoVis 2010.
#' @author Justin Talbot \email{jtalbot@@stanford.edu}, Jeffrey B. Arnold, Baptiste Auguie
#' @rdname range_breaks
#' @export
extended_range_breaks_ <- function(
dmin,
dmax,
n = 5, # nolint: cyclocomp_linter
Q = c(1, 5, 2, 2.5, 4, 3), # nolint: object_name_linter
w = c(0.25, 0.2, 0.5, 0.05)
) {
eps <- .Machine$double.eps * 100
if (dmin > dmax) {
temp <- dmin
dmin <- dmax
dmax <- temp
}
if (dmax - dmin < eps) {
# if the range is near the floating point limit,
# let seq generate some equally spaced steps.
return(seq(from = dmin, to = dmax, length.out = n))
}
n <- length(Q)
best <- list()
best$score <- -2
j <- 1
while (j < Inf) {
for (q in Q) {
sm <- .simplicity_max(q, Q, j)
if ((w[1] * sm + w[2] + w[3] + w[4]) < best$score) {
j <- Inf
break
}
k <- 2
while (k < Inf) {
dm <- .density_max(k, n)
if ((w[1] * sm + w[2] + w[3] * dm + w[4]) < best$score) {
break
}
delta <- (dmax - dmin) / (k + 1) / j / q
z <- ceiling(log(delta, base = 10))
while (z < Inf) {
step <- j * q * 10^z
cm <- .coverage_max(dmin, dmax, step * (k - 1))
if ((w[1] * sm + w[2] * cm + w[3] * dm + w[4]) < best$score) {
break
}
min_start <- floor(dmax / (step)) * j - (k - 1) * j
max_start <- ceiling(dmin / (step)) * j
if (min_start > max_start) {
z <- z + 1
next
}
for (start in min_start:max_start) {
lmin <- start * (step / j)
lmax <- lmin + step * (k - 1)
lstep <- step
s <- .simplicity(q, Q, j, lmin, lmax, lstep)
c <- .coverage(dmin, dmax, lmin, lmax)
g <- .density(k, n, dmin, dmax, lmin, lmax)
l <- .legibility(lmin, lmax, lstep)
score <- w[1] * s + w[2] * c + w[3] * g + w[4] * l
if (
score > best$score &&
lmin >= dmin &&
lmax <= dmax
) {
best <- list(
lmin = lmin,
lmax = lmax,
lstep = lstep,
score = score
)
}
}
z <- z + 1
}
k <- k + 1
}
}
j <- j + 1
}
breaks <- seq(from = best$lmin, to = best$lmax, by = best$lstep)
if (length(breaks) >= 2) {
breaks[1] <- dmin
breaks[length(breaks)] <- dmax
}
breaks
}
#' @rdname range_breaks
#' @param ... other arguments passed to \code{extended_range_breaks_()}
#' @return A function which returns breaks given a vector.
#' @export
extended_range_breaks <- function(n = 5, ...) {
function(x) {
extended_range_breaks_(min(x), max(x), n, ...)
}
}
# from scales package
zero_range <- function(x, tol = 1000 * .Machine$double.eps) {
if (length(x) == 1) {
return(TRUE)
}
if (length(x) != 2) {
stop("x must be length 1 or 2")
}
if (any(is.na(x))) {
return(NA)
}
if (x[1] == x[2]) {
return(TRUE)
}
if (all(is.infinite(x))) {
return(FALSE)
}
m <- min(abs(x))
if (m == 0) {
return(FALSE)
}
abs((x[1] - x[2]) / m) < tol
}
# from scales package
precision <- function(x) {
rng <- range(x, na.rm = TRUE)
span <- if (zero_range(rng)) {
abs(rng[1])
} else {
diff(rng)
}
10^floor(log10(span))
}
# nolint start
#' Format numbers with automatic number of digits
#'
#' @param x A numeric vector to format
#' @param ... Parameters passed to \code{\link{format}()}
#'
#' @references Josh O'Brien,
#' \url{https://stackoverflow.com/questions/23169938/select-accuracy-to-display-additional-axis-breaks/23171858#23171858}.
#' @author Josh O'Brien, Baptise Auguie, Jeffrey B. Arnold
#' @return A character vector.
#' \code{smart_digits_format()} returns a function with a single argument
#' \code{x}, a numeric vector, that returns a character vector.
#'
#' @rdname smart_digits
#' @export
# nolint end
smart_digits <- function(x, ...) {
if (length(x) == 0) {
return(character())
}
accuracy <- precision(x)
x <- round(x / accuracy) * accuracy
format(x, ...)
}
#' @rdname smart_digits
#' @export
smart_digits_format <- function(x, ...) {
function(x) smart_digits(x, ...)
}
# nolint end: object_name_linter
ggthemes/data/ 0000755 0001762 0000144 00000000000 15112661116 012766 5 ustar ligges users ggthemes/data/ggthemes_data.rda 0000644 0001762 0000144 00000031317 15112661116 016257 0 ustar ligges users BZh91AY&SYÆ#5P „ôÿÿÿÿÿë¯ÿôÿÿÿèÿÿÿð{ùÿõóü_ÿP ÿð~ïÿà8=ðù}Òe§·ßq$}}· ß`£Yv*ÛE‡!{èR°ôÒ÷}^2” èÐ: ¨
*€j€hkAH§s:ûïsÇ|Ç·n{{:óȆ–×=Mœ{ÎU{±ÊW›×
o{ÇBóÎxÏwˆð(B™
>u‹Ð ÈÑ¡4Ɉ ši©êe¦š4dÐi ™§¨Ñ 4hÑ£@4
4
lMA "L§¨44H 4 ‚
f©êz”ôÓÊ@ÈÐhbdFLÉ @Ð 4 ""hh€L%=‘OÅ6¦§¡”õ‡¨ôi6
4 2@ È @h"R"4Ñ4Q£@z Ô
4hhé§”ÐÑê ié ÍFÒ=FA
Ñ£@hhhÓÔÑ D¡"h
©âž€&”ñ¢ySț҇¨=56¦žD4 4€ `Dü
1¾
Ì`Ö
¤Bà-PÄi ‰ ˜ÄFâäQ¼¼@];‘àU™(]z^H€†BñAL—Ü9à‹z"SÚÓȨåâ^TB®J€…@jZ¨@Q±T*TT³kYRÂ!Y»Ú4Pb#˜ÈÈÕ´Kh‚Û(Dî‚Ñ/¼3.¨ÐöNŸ1¢½Õë56C’Öûž^føo€v ´ÚŠQ^#G¯´ˆðU:Ñ“Ýûªt@øù‡¹ ’1_ÁmiõŸQ1F‹êŽÕaÇÇìúÜR™§¬1/®]ÝÁž0U™1K2yhxX.ãB†´ÓÓÇÚsV¿>‡5y#±Ï‰>xá±{J¬NxŠ‘èlùÍÎCí”%X@—>Ãm¡ >Ìm¤\ëÉ7‡Óo/$xŽÏ€q`½îñËaœ;,Ï å)-<—õ÷˜¼Kó, ^nG-3®Lóþߎf¿*8í…u.m´÷5E›ÆàÃ6•)f$§ëš¾zw:°E¸ÉfÓF½ºÊëÕïI.è݉£ÑßXX°ìï„Q÷»Y<^Øyc~¨ÇfAÈ¿“Χ(9«®T]6ÿ[ØÝ’5î±gëñ‰ÓËõ-Ú²D¡\˜ hZ›€]__vý¯SO¶}*ö”C±ý†ÈD‘‹ÃážÅLBQ”´>{¾xÑêÄxÈÏ ’éR¼ûÚ ½Üûu€¦Þˆêˆhü,´pøZ>Ìv”E
Úóôòkh¯x»—ËèµÝŸ5ÇÝ’kÐ1‘"‰¬ÌúÕ½óO.ž. õ6@ .ÃN:lˆ+UЍP{õàß—G2ÌBÑÅ(Di ÀPRŠ+ €Ü–t4ä3Ç?’Žþ½>}Mãò‘gƒx±bÙb•ˆO‰ÁøûK9"TxëñX Ç–Uúˆ¬jå]ßtóøÀÐXRët€ZÍÜa]wKÇåd£–ÐûOÓüÇØÌˆ0ˆB‘ ›oðß7 ßÅPñ ò˜d`Ì+!;Éb؆s@Îþ^¼àèç‹©0˜Â¤žÎÃoPSH‡IA²¶9ZÚtêùå«-íw,ivºg^Ê-G¢7àSt=ưñPT{s ³$Klµ€ú}ç{Ýô.î< í2¼Ÿ0»¿²m÷Š
ò¢¼rаíÈí=£F|Æ´ì1y9ñ|š²Á¤Ëé)±·ôlïnIf÷cqO¯e‰–×Ú¦ZïKùW»W✞êIû>í¯÷'ØVÞÃå÷©ž¢?契¿«õÎÊûÜ=æœ_˜xù|lï?³1ä"äùÑ
["Ñâ‡ügåøwòÿÏÇ‚‡mp€@våÄ3ðuŠª&7]šº·³Ý2s˜üL×½¯élcüû+¹ÒØÅê
«¤7¢Xqû¬q·a¨m=ì@‘,j*™5•jx›ÖpY×¼E½E¿n;æw^î¤÷n¤÷ò>ÖF*4æ›Vq8a Bˆ‚ˆi~lõË¡l7h6óOo·ÔŸFåBlm;PC÷þV©9†¬0… <«PÔMç/Å;ohFg¨®ÑWH(2èE˜ÃZPÙDa±—œ1ÔãÔϸáÕµ“I@$‚²!4î¿TøSȻƧcØÖlANc¬Ê?äu¬0è¬'ïCûÉWCY%Et‹iŒðÕô$=µöêH“kiš™4½o&b]›
&÷¬y=çÑ*¼'«û½x9«÷séz鈿Üþ‹Û˜qnž‹4Ða`ÅÜXzŽBâdYù;¬ãP…ª)(x;á‹yù¥ÛR¯lZ-Ù’ sÂ’n
†pøF¼¨ÃÑü•Cï>% ˆŠŠ5g¦J…ºØÊ†f1È`|À7“*mË!ŸEYŽ(áUãMfªs.W¡
Ú–i×…è«{^~ª1çåU&B-Б~•{ô}øÈÕCùÞ¤²ïºZÖçÃïHô©fëÑ@Eøkm‘T˜©ê‚’ æ¯vŽ(bXl…«+·„ê†S²^J[E¯¼"E[j™…ýPU,Š›©mȱ&ùëQb@´~W©«~n õ1AmZ‹júÏ
³^Å•¯¿"…kŸ‹
–kÊÈwéšH„Båal·5^ÄÈíˆÜÙbQÇ.d©Ð=EJjF¤¦JDyáÉ[j7n%—2äE_M
)»ðSäëkƒº.Gùá?QÏ:9‡kçæòrä@`Á™˜`LšØ£Í›÷SR˜Žt»2
‚¬ì!áxFrC¥NšU=‚EO Åšy 9TÈ—ƒ¤!¨p=Ÿ,:–É^DÉ`Z_޼
«!ßIÄ76¥,šÇ™&V»Ô·Z—¢•1Ãs›†–¯S·:nË6ØE`mƒ°ëv´ívrå„Ct]¦L–VÊ${(¥’ï¶ ‘‚›·™;Dg>¢XGåòÐŽ >:/£òæ\d‘Aߟ¯T¥ývç¬ ‡ÒëÄÇ[¦ÁÆ^ÆÃƒõ”-|½!-zì{ë”Ø”>ÑE
“pÜE£nÓ*.½RRä“Jï\X²FõuÓ¬yzLª´×JžXÑiUŽ»kļš©-釀º
A4ñ»ÞõZÝ»ÊÇÐddr$?š ð‡„È‹ìQ%më¤àœ] åW,˜&»Ïhw ÐY,¸x* ª$¡ŽR\Kˆ M0˜Qƒ"©zÝÈïr¬æ´žF.©@æc»,›¯-y(“s»¤®ãÎq1\μÝq)T¾°ápÞfòÏã„σ¿RÄ5öÐ`êñp¢³¸tر¬HÕ¬q^q±GšsÒH$ã’wßC”#é¢!Ò]®ª6a*Ù”ó(fvÞ6.*›é·š´3*uñyÑÎA¥ÔÞžU½¥;"{zÆï‘õœKPƒæ_ªÎü!Áà¹ÞÒÏ}Ï£óŠžïÆÖå]ª{kA¾^Æ“„ÑRªYEnÐHÎsÑ„ßÅúù¼ù¾5äËÜÀ¸ô:òÚo\wá{_'ê‚·J—Qqç†NaLxФA
"žuמ`ï%Iumo>hY¹_h/—½ýâ¹KÃa©ÆÔùo'm:Pƒí§^κõëÐÅu²‹Y™ƒ335ôè~ÝóãwÜ\‡±Â^]EZCÚƒÖ-íªÞMZ{¶iPÍÐlTóÆá¡Ze+*q5ù7^67ˆµƒÌ.x9ÆAp¼Ž!¬ôv\B“ª`Û§êNº¯Áí„F£Gãœ-9ù[¹¢’äiz|Ië+XæíÀŠÍ.£®R–[ÑŸ TV”§˜hÓŽhs•$˜¼ò·ˆµzùhÌû;mí|e™ø{¾å9rm)óÔø®”þ|@ùÇcUÀªßÛ”œo±õS~¹Ô§ƒ¨€¤·5Þ‚X –© c¦Œ˜½¸ðÏ‹‰˜ËÈÆDG2ßãÞapÙe|¨Z£€Ž)yz&fN ,wl¿¨¸ æ~I¡ß>nàAUiÄzOŒÆ0M‚{lêÜçœèbC"à™l:¿Km¼‘²k6bŒH9÷ÕÄö™\õ,UdXEp ª–˜x¢²]q Q©çAJŒº)ßå ×µÖ÷Õ¤ñ~ên’Î(=tÇJt´ŒŸs¿ºÎú´nzeS•Õ{ênòåO¤¾b÷°†sù{MêÌG}.N·Ì!
Œ€E©7W–׊̃ÕZ&Z_†Ó ”!%³(péð gÀM[ÑŸ/]‘‡ž¯É;_JßàÑ²Ó ÑR^ƒ– ‚1óÆÂ¼ÈT&Ž£MH”ç)³³‡]
¯RýÆ£˜jõLŽ–ƒÖI•ߥ±³èžÔ±Ü(èåæà°ãxn5RTBÚÔ³£H‚+Ä¡ %Óh€Šó’ ¨ D¤!DæsÅY/ŠW¼™úšD8Š®Ú €U@Êê5Š´,¢±"ŠÖ…U…¢‹X Åg¸¡H,Šz™¨µ™¥&zÂ’†1±Ê
’mÂÕ E5ª) b"¢¢©Ñ /‚ª$Q¯‚‚À "°b)€
$„ˆ¡»†*)X‚
þ|ã‚!³
("©•/”‚È£‚A)@(HU3AM-ãÖèhlpö'b[£Ê¿/,íkZµ+ZÖoq•ìNÒõz¹Dz$í½hv
Þ>^©á0e²o•Ý¿ÕÆ4Á¶ÆÆÙì8`E‘!î‚*÷ñ“™¢–-RäÛM¦6ñDi<`v‰øy”J(ý(\}fm$špҽ焥ze@3h(cØW¥ÈãÒÀo"Jó ²¸Õ‰7ßŦÑÄêafÒá<£y݃ ¢…È{
:GO¬4è7ù{îçïú^-›ØÛm½{Èd×Ñy±æPu4uÛØ
öuiËê ¤ä'úP_Â’wB<ÍÚ›cѸ„áÇeàR)ÉÜ £pÆ3´TѧÝG8ÆÓˆqë™»µ¶5$g›(÷ôR»;À««NŽ˜c=þ W=sÏ ›Î
Ÿ«O S˳@=ŠOšl™ôÒ¶l?6Fl0\“Þrh¨SHb7æ2+ú‹6F£ƒü# Ï7M·½ïpûœ.òÆ I¥•ÙD‡@@]ò±Ú¬æÕ¦áºp¨V€Î À 13<²t`'…Ì[‰¯ŽM³i$v¹e ¦Q ãBÈ@gÃ^ùº rý¹¤$Ã_Ê™±QÚ!—Ú7„´á
¼6IW•ÊÇŽFXl͸VåÂ2rÆ–£8é ȤïˆÔ`ed¹eIkIŰzűéP\Æ´Ü¿TÃÒ\.ÌPH
×’ñt-ÍÂ\P€P
q¹¸dT4ZÐPFÈõM÷Ù
Œ÷¥¯£}iJ–v3¸ÖÛZ 0Ùt¼&B‡1QhÖWŠÄ<ﵦïF~s9¡ßн”]ØIF@MvÛV7ìÍLXã÷Çjlt2Eâ""âàw§
Ã‡ŽØ«æÀ,ÔØÀ€&üÛ`:õÔ¯ÅÐÌR1#;µV_®ñ?@`í$†ùÚ_´ÓNË„çl«Æž–€‹ù&‚Ã}M¨q¦Owó BÐrvŒÒL4p6'üÚC?PÆ`r‚ûÏ‚Dˆ¨–¸#Šõ¤y û\Ë\§\ˆL¾¥†9Ðn\¸†Ë®à ¸è1O%S£*Ѱù˜ôšÁFêõB`㡘û{Iäøä 1
£€Wz¼:ôdÚ`sìI†ÖV2[w¸¹
{Žâ<¿YMˆÂ«âLLøÖxPdNÞK*@Â!hÃß§3çÇiÅ_vÓjhàû³“Ò]2Ò—
\lÛâÈ_vßMs3¨HwÙ& ѼL‡³?£R¨Nn¨ õ¸5¥z@‹&‚8R;YMì.ZÛYWbadà߯ä±!%UÃZϤ €`È̈£3ñE¯´Ôç‚2NNª,ýâŒÈ‡ÀÙ1šz¿É6ª®ÖÅw‰ƒd³Ej©Äë7¤¢°¨MêÇ=Ú/È/°ýûÑÎÕ®ƒ9¾ÍöŸ=èw8o1Àp-nè5AèÐyàÀíŽ0søüùÚ9!Ð#v'[r
Eæ8ž€€"!ôNÏÌŠF“jpCt:L3gÙuÎp2º÷×€»ºVú.«°.%Ç$ÁÉ[ãHjžsÌööcÐD!3@
Óûo>d×:€ÏÝè`…ÀO]ço“i „óëe,iµ“_†8FÀ¥¹ô!ß™íý¯Y‚ŠöúÔºäNÌør’ï³?=DÄ«™¼’xÚHdd‰ÅÐ;8$ÂŒÍÞo„pq;æð„Ë'‘xmçb`Äçà™aôJç«L:ˆs¡PQYΉBˆqa"T@|õ¹ÄÆeIÄéx¹HÔÎ/(yÑoŒæëØçk)Á¢(/'·´Aó±–ôš{qӛ޼ÄN¯éBS¡ ž=ˆjóŸo /l"¥Ä{Pg*3
¡`l3 úü>ú-Z£¬>ð2ž»¤`8÷ìk“¯Jg&‰Ä€ÀIåRÄFœÔ¾c£5ê¨s»°¨6=Û=£°¨&72ç$\cä4 iÇ=Ò¥ÁÔùð*GXXì¼ÍùÄìÄ7!Åàq@ó>1öÆuŒB{¯½è¸»© A¡>4¯‡%ˆMh”ù2a8u1¶6 µªeº˜?/ÕÚ0ªš^;X8nÑ®6$TMw¸Œ¥ø¢´ù6Þa/ S¤%©ñ˜ bdg[œèa»×LùáQÜw«ñ©Yì8‹3R꘴|ǘÍÖÕ@’9ÍlaµD±trB›„ç88x´Ò‘ËNiC´1‚bŒ¥y8Žº+ޏ¸q~b²Ž»¸•ÛGÉ“Ô{eWöõ²Éz0zð¹¢+“nzöFcÇ™£ø¦+À¥…«›’ÜäÅ25Ô®ò…èÝô†Šp4Y\ò·çf”|Æè¡’$Â'Oc¼å†U‚ fˆq…P8¨ÚCÒoËÄUù†h+ÆUA[¡åQÚ;¯×^oÒ¡yˆkSˆØ›÷ Q2•¡ „FE^¦• kA‘£²Œ•ŠìIÈw•½R vž£˜ŒÕV¸ÓävBªT:µî0”VDŒ–à×3äZ [y5ß–=Q,Çu K0Ò=+»DS[»ËªÝlÃp‹R<àžˆ›LŠïÎ𰬘Lhêä"¸Ó0Òœ¦{¼ÔDTå'R
c;;+ÄdúÞ_/Ç~
NìêŽrÊL T"P! pÝ׈86+VœÞoa
R =ï\Ê®e!Óšš¶I‘_0EXL˜Æ¶Ç·>‡z–Ї¡ÊLÆ*´W
œõÚÙ Í¿5aÙøa¥x}®¬q¹ˆØ‘NY§Lõx0lN0žŠcÚ§Àõ3©EŒôcÑdöÞ˜ÇtÕ’CàzÓK$Õ¦ùÐëw×)ÔE$rGJ†@}Ùä]r* ø
ŠÒ0ëH Ä¯›Kp—fdJmk‹lm†kKÄ»d¾¸¹ad; µÄãŠwªåœG©ØQoÊ-ê¥l·
°ÌéokDZÀ®*G-bäÔÒcM ÈR¼ˆÉ`³ÝÓ'~€"ñTèònu3ŒMÆ+0cRUâH— ^n¨¹háæ
ŒL‰²!6a¶)ÖϘ€D\@T/'½‚eÖÆš£ÖŠ)„ÛAcÔÐŽFPµG‚…Öîʽ
ÓËÁÎö-ªÅ,¢{ó<ínš^æÓAŽt‰l¥¬{µ÷½Îpç/–r®ñ \Np–eH^4RAôÈoÑÓ™(žÉ®#ïè½GÌÛ~çt;YÕ©ÒØFJØ·}žlÃÉìê·§bÒÁ† g¹fŽ’æ|>[;ÏÄÔ´ðc 8ƒrÖª…95.‘÷îÈS$¼W£9a‚†BǤ
ÁIÒMe¨Žý’ÅQXŸ)NõêYÎi°*=8Ä"%pÔõ61©æV~\ºK¬ZçÀöuHëŠ +†j±
/íÊÛ¹e·'ÅÆ¥jq1Mɬª`åÉç½ÁÓòI=pÜ)éÂË2 ’ØXIŽk$»U±»´ ÍqÊÈü“p5U8‘
ôno´`r•j~Zõ tóÇbï=]@ £S˜ãÑ;½n2‹Jy
¤z@0ÆIÎñ®ïâ ¢Á€Ý kV’P$#0eÝoÍ„qqi´Ò
‹ÎR×®l$šè6Ç5ºw1àÄüSB‡Hvjë¨VVœ˜^ÂHÂâ}’°ˆµAnÖÓS4¡©HŠZ!£ÆÍI œÅÆ 7XÁUã"ô¶]sÑÊ;
{
t=Z‘? ª[˜f\R¬‰,¼ö…ê+Ep"êEeÓÞOYZ¾¤1E[(õë—¨ÂsЧ´;:¦Ã~Ì!± Å4Ëqªî~Û¨Ùs‰•ÖÀ<%Ö.«}-‡ž¡†¤ÐS† ïT6µ_XÛ‘
Ø6/PwŒChø¾ £yÀ°Í…µ›3[×bX[RÚÀB„}Gq´G%zuºÀ1•Yn'u+el9jP¹jI%³Õ-cNŠyOº Fܖ؉µc‡Ôú J2îÎ íÙ‡1 Gt²‹—c5)ÎÊa:TD5ÍšpŸÞ$3ºyʰ¤;ÝZÁB4œØb)Í8YG>E.ò‰óHŸPÉ4+bË¥eŠ*Ô‚ç]ß®|íyÌê† 1Îg(OEÃ@ydñLލV`—-^Ã*{©…1”MS/®ëJ‚PÖÇFƒ!«1X#áÅÔbs¥ÆA7f! ï½uçõœÒG²°8¹çåM·Ûb{æìP«‰ãžuÓ*2Ï|·ªšÉ1ëFÁo¦) Ü̪Æs¿¿^K›r
šq9©FspÜO:+Ë}Õèab@K8³7Bžiï
úŸº‡³}é¤" 0e³¨gImqYž„¨¤qˆ÷Ù™Ž®7á„Ês ¥\åF€Gá·®~–~îß/—ß9{¯€æÂ>EÛÞTƒøÚžÅ¿ž†
«Ö/q«àÑÀ V÷Ax;0¬}Rƒo¹ ËÞqبå©tæKš´éËÌxŃ˜¸g0€(
q0¾m\¬#Ÿ°|LR¢*ÊÏŽaƒ,»½o‚ÕÀUt¡‚¨(r‘ ª5ããqab””ÃÏ¥&Ê/cž81ç8¹®ªcŽ™ƒ†¸˜ÅÀ ™…HÑ'¦ª¹cÑ-]PÃ2И5a¨ 3PB½½&8´¸iTT˜e§s´g…Lè ºc9o.¨ƒæ C'>˜Ù®f»U58ÊÞ2a9ktpòøõãníxVm¿OÞp“Œí"‰¿ÉX$¯7ÏÊÄ7 —àhÈ0Ø1¤e³œÝy
c¿~Û Ð¾²¹½ l˜yæ)§J˜\”(ÜÖjN–œT–\’à„6¦©6mfp©QzŠºÜØØËSä%ÑñAGv‰}¨:$6›ˆœP!p׈«R¹°«À¼ÄOS,iæöóC$ÝÌR5èiï|¤óÎêö71Ù¶tE4˜0HµÊ½d‡Ó,"Ѭ]‚µ¸)b†¶L} ¸
QpHˆ‚Æo¿lì0ž£0:Ó9®‚@ùGÄ$רõ"ðב(óÈÌRFus> ⣔hXm‘_Lí`ζd™åàâ‹È.xX,Z0:9ʤf8î¯gœjå…šmcÑežˆ®Jí±
ËLN6ͬ†ˆ³™…™ì…4¥‹dFÎm¸§U0v>ù_
NÖväܶmú½DŽp²†,Ø4´üíÛ©M´?<ƒ˜ÜA
@:‰…¦}n¥m°NóbšÆŸ
™î™Œj‰
˜¬Ýa „6‚66”Ò'FvÄØh¥µï|¥+(F諒ql£
’Ø BÔ‚h’gÍÆ±N¯Xß³³•†Þæy ^T9‰¢!1r€yqÀw”.Bƒ_~Pohå€8†P€KÙµ©^¼©´‹ïÝú„Rñ°õÖB;§³ëïå:NÅ4(5ÐÕÓÐç©Õ·\¾ëݺ/¥'Nl/Q#¾
ï”PFnh šCZb’pµ=ãËÊ=Äk¡¥æªôÃ$âPÅŸ¿ZVÉ:Šq¤Åž5•æCH‘h@Ø0—k`8Z'Yéñ‘Œ
X¸‰¾m;báékhØÙyºÀß[^*4ÅW…Õ±Ã@8]?WMQƒ¡=Ûƒ]iî߾“/èßæáTåÍ™$$dBˆI$„!E¿´àóß¶©2³’õ1 ´DÏg¹ÖëOXžÇZ ú•£)ðŽøŸRy×ñù$ŒT¢ÈÉž