tests/testthat/test-free-vp.R

In ggalign: A 'ggplot2' Extension for Composable Visualization

test_that("free_vp() assigns class and viewport attribute", {
    p <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) +
        ggplot2::geom_point()
    p_vp <- free_vp(p, x = 0.3, y = 0.7, width = 0.5, height = 0.4)

    expect_s3_class(p_vp, "ggalign_free_vp")
    expect_s3_class(p_vp, "ggplot")
    vp <- attr(p_vp, "ggalign_free_vp")
    expect_true(inherits(vp, "viewport"))
    expect_equal(as.numeric(vp$x), 0.3)
    expect_equal(as.numeric(vp$y), 0.7)
    expect_equal(as.numeric(vp$width), 0.5)
    expect_equal(as.numeric(vp$height), 0.4)
})

test_that("free_space() works with alignpatch objects", {
    p <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) +
        ggplot2::geom_point()
    class(p) <- c("alignpatches", class(p))
    p_vp <- free_vp(p, x = 0.1, y = 0.9)

    expect_s3_class(p_vp, "ggalign_free_vp")
    expect_equal(as.numeric(attr(p_vp, "ggalign_free_vp")$x), 0.1)
    expect_equal(as.numeric(attr(p_vp, "ggalign_free_vp")$y), 0.9)
})

test_that("free_vp() uses defaults when width/height missing", {
    p <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) +
        ggplot2::geom_point()
    p_vp <- free_vp(p)

    vp <- attr(p_vp, "ggalign_free_vp")
    expect_true(inherits(vp, "viewport"))
    expect_equal(as.numeric(vp$x), 0.5)
    expect_equal(as.numeric(vp$y), 0.5)
    expect_true(is.na(as.numeric(vp$width)))
    expect_true(is.na(as.numeric(vp$height)))
})

test_that("patch.free_vp ggproto object overrides align_border", {
    p <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) +
        ggplot2::geom_point()
    p <- free_vp(p)
    obj <- patch(p)

    expect_s3_class(obj, "PatchFreeViewport")
    expect_true(is.function(obj$align_border))
    expect_identical(attr(p, "ggalign_free_vp"), obj$vp)
})