Skip to content

Commit

Permalink
incorporate getter in tests
Browse files Browse the repository at this point in the history
  • Loading branch information
teunbrand committed Sep 5, 2024
1 parent d952f38 commit 48e7dcf
Showing 1 changed file with 25 additions and 46 deletions.
71 changes: 25 additions & 46 deletions tests/testthat/test-labels.R
Original file line number Diff line number Diff line change
Expand Up @@ -52,24 +52,22 @@ test_that("setting guide labels works", {
test_that("Labels from default stat mapping are overwritten by default labels", {
p <- ggplot(mpg, aes(displ, hwy)) +
geom_density2d()
labels <- ggplot_build(p)$plot$labels

labels <- get_labs(p)
expect_equal(labels$colour[1], "colour")
expect_true(attr(labels$colour, "fallback"))

p <- p + geom_smooth(aes(color = drv), method = "lm", formula = y ~ x)
labels <- ggplot_build(p)$plot$labels

expect_equal(labels$colour, "drv")
expect_equal(get_labs(p)$colour, "drv")
})

test_that("Labels can be extracted from attributes", {
df <- mtcars
attr(df$mpg, "label") <- "Miles per gallon"

p <- ggplot(df, aes(mpg, disp)) + geom_point()
labels <- ggplot_build(p)$plot$labels

labels <- get_labs(p)
expect_equal(labels$x, "Miles per gallon")
expect_equal(labels$y, "disp")
})
Expand All @@ -79,14 +77,10 @@ test_that("Labels from static aesthetics are ignored (#6003)", {
df <- data.frame(x = 1, y = 1, f = 1)

p <- ggplot(df, aes(x, y, colour = f)) + geom_point()
labels <- ggplot_build(p)$plot$labels

expect_equal(labels$colour, "f")
expect_equal(get_labs(p)$colour, "f")

p <- ggplot(df, aes(x, y, colour = f)) + geom_point(colour = "blue")
labels <- ggplot_build(p)$plot$labels

expect_null(labels$colour)
expect_null(get_labs(p)$colour)
})

test_that("alt text is returned", {
Expand Down Expand Up @@ -140,24 +134,25 @@ test_that("position axis label hierarchy works as intended", {
geom_point(size = 5)

p <- ggplot_build(p)
resolve_label <- function(x) p$layout$resolve_label(x, p$plot$labels)

# In absence of explicit title, get title from mapping
expect_identical(
p$layout$resolve_label(p$layout$panel_scales_x[[1]], p$plot$labels),
resolve_label(p$layout$panel_scales_x[[1]]),
list(secondary = NULL, primary = "foo")
)
expect_identical(
p$layout$resolve_label(p$layout$panel_scales_y[[1]], p$plot$labels),
resolve_label(p$layout$panel_scales_y[[1]]),
list(primary = "bar", secondary = NULL)
)

# Scale name overrules mapping label
expect_identical(
p$layout$resolve_label(scale_x_continuous("Baz"), p$plot$labels),
resolve_label(scale_x_continuous("Baz")),
list(secondary = NULL, primary = "Baz")
)
expect_identical(
p$layout$resolve_label(scale_y_continuous("Qux"), p$plot$labels),
resolve_label(scale_y_continuous("Qux")),
list(primary = "Qux", secondary = NULL)
)

Expand All @@ -167,23 +162,23 @@ test_that("position axis label hierarchy works as intended", {
p$plot$layers
)
expect_identical(
p$layout$resolve_label(scale_x_continuous("Baz"), p$plot$labels),
resolve_label(scale_x_continuous("Baz")),
list(secondary = NULL, primary = "quuX")
)
expect_identical(
p$layout$resolve_label(scale_y_continuous("Qux"), p$plot$labels),
resolve_label(scale_y_continuous("Qux")),
list(primary = "corgE", secondary = NULL)
)

# Secondary axis names work
xsec <- scale_x_continuous("Baz", sec.axis = dup_axis(name = "grault"))
expect_identical(
p$layout$resolve_label(xsec, p$plot$labels),
resolve_label(xsec),
list(secondary = "grault", primary = "quuX")
)
ysec <- scale_y_continuous("Qux", sec.axis = dup_axis(name = "garply"))
expect_identical(
p$layout$resolve_label(ysec, p$plot$labels),
resolve_label(ysec),
list(primary = "corgE", secondary = "garply")
)

Expand All @@ -194,12 +189,12 @@ test_that("position axis label hierarchy works as intended", {
p$plot$layers
)
expect_identical(
p$layout$resolve_label(xsec, p$plot$labels),
resolve_label(xsec),
list(secondary = "waldo", primary = "quuX")
)
ysec <- scale_y_continuous("Qux", sec.axis = dup_axis(name = "garply"))
expect_identical(
p$layout$resolve_label(ysec, p$plot$labels),
resolve_label(ysec),
list(primary = "corgE", secondary = "fred")
)
})
Expand All @@ -220,31 +215,20 @@ test_that("moving guide positions lets titles follow", {
),
p$plot$layers
)
expect_identical(
p$layout$resolve_label(p$layout$panel_scales_x[[1]], p$plot$labels),
list(secondary = NULL, primary = "baz")
)
expect_identical(
p$layout$resolve_label(p$layout$panel_scales_y[[1]], p$plot$labels),
list(primary = "qux", secondary = NULL)
)
labs <- get_labs(p)
expect <- list(x = "baz", x.sec = NULL, y = "qux", y.sec = NULL)
expect_identical(labs[names(expect)], expect)

# Guides at secondary positions (changes order of primary/secondary)
# Guides at secondary positions
p$layout$setup_panel_guides(
guides_list(
list(x = guide_axis("baz", position = "top"),
y = guide_axis("qux", position = "right"))
),
p$plot$layers
)
expect_identical(
p$layout$resolve_label(p$layout$panel_scales_x[[1]], p$plot$labels),
list(primary = "baz", secondary = NULL)
)
expect_identical(
p$layout$resolve_label(p$layout$panel_scales_y[[1]], p$plot$labels),
list(secondary = NULL, primary = "qux")
)
labs <- get_labs(p)
expect_identical(labs[names(expect)], expect)

# Primary guides at secondary positions with
# secondary guides at primary positions
Expand All @@ -257,14 +241,9 @@ test_that("moving guide positions lets titles follow", {
),
p$plot$layers
)
expect_identical(
p$layout$resolve_label(p$layout$panel_scales_x[[1]], p$plot$labels),
list(primary = "baz", secondary = "quux")
)
expect_identical(
p$layout$resolve_label(p$layout$panel_scales_y[[1]], p$plot$labels),
list(secondary = "corge", primary = "qux")
)
labs <- get_labs(p)
expect[c("x.sec", "y.sec")] <- list("quux", "corge")
expect_identical(labs[names(expect)], expect)
})

# Visual tests ------------------------------------------------------------
Expand Down

0 comments on commit 48e7dcf

Please sign in to comment.