diff --git a/R/subscale.R b/R/subscale.R index 48f21992..b97f36b9 100755 --- a/R/subscale.R +++ b/R/subscale.R @@ -52,7 +52,7 @@ #' subguide = "inside", #' subscale = subscale_thickness(expand = expansion(c(0, 0.5))) #' ) -#' @importFrom scales rescale oob_squish_infinite expand_range +#' @importFrom scales rescale expand_range #' @export subscale_thickness = auto_partial(name = "subscale_thickness", function( x, @@ -79,9 +79,6 @@ subscale_thickness = auto_partial(name = "subscale_thickness", function( limits = c(NA_real_, NA_real_) } - # infinite values get plotted at the max height (e.g. for point masses) - x = oob_squish_infinite(x) - thickness(x, limits[1], limits[2]) }) @@ -89,8 +86,8 @@ subscale_thickness = auto_partial(name = "subscale_thickness", function( #' #' This is an identity sub-scale for the `thickness` aesthetic #' in \pkg{ggdist}. It returns its input as a [thickness] vector without -#' rescaling (though it does squish infinite values). It can be used with the -#' `subscale` parameter of [geom_slabinterval()]. +#' rescaling. It can be used with the `subscale` parameter of +#' [geom_slabinterval()]. #' #' @inheritParams subscale_thickness #' @returns A [thickness] vector of the same length as `x`, with infinite @@ -98,13 +95,24 @@ subscale_thickness = auto_partial(name = "subscale_thickness", function( #' @family sub-scales #' @export subscale_identity = function(x) { - limits = range(0, 1, x, na.rm = TRUE, finite = TRUE) - thickness(oob_squish_infinite(x, range = limits)) + thickness(x) } # apply a thickness subscale ---------------------------------------------- +#' Squish infinite values in a [thickness] vector +#' @importFrom scale oob_squish_infinite +#' @noRd +squish_infinite_thickness = function(x) { + limits = range( + 0, 1, field(x, "x"), thickness_lower(x), thickness_upper(x), + na.rm = TRUE, finite = TRUE + ) + field(x, "x") = oob_squish_infinite(field(x, "x"), range = limits) + x +} + #' apply a thickness subscale to an object #' @noRd apply_subscale = function(x, subscale) UseMethod("apply_subscale") @@ -116,15 +124,14 @@ apply_subscale.NULL = function(x, subscale) { #' @export apply_subscale.default = function(x, subscale) { - subscale(x) + squish_infinite_thickness(subscale(x)) } -#' @importFrom scales oob_squish_infinite #' @export apply_subscale.ggdist_thickness = function(x, subscale) { # thickness values passed directly into the geom (e.g. by - # scale_thickness_shared()) are not normalized again. - x + # scale_thickness_shared()) are not scaled again. + squish_infinite_thickness(x) } #' @export diff --git a/tests/testthat/test.scale_thickness.R b/tests/testthat/test.scale_thickness.R index af7b6f3d..f4a50a02 100755 --- a/tests/testthat/test.scale_thickness.R +++ b/tests/testthat/test.scale_thickness.R @@ -7,7 +7,6 @@ library(dplyr) library(distributional) - # scale_thickness --------------------------------------------------------- test_that("basic scale_thickness_shared works", { @@ -33,59 +32,21 @@ test_that("basic scale_thickness_shared works", { ) }) +test_that("infinite thickness is squished", { + p = ggplot() + + geom_slab(aes(x = 1:3, thickness = thickness(c(0, Inf, -Inf)))) + + coord_cartesian(expand = FALSE) -# scale_type -------------------------------------------------------------- - -test_that("scale_type works", { - expect_equal(scale_type(thickness(1)), "continuous") -}) - - -# thickness type ---------------------------------------------------------- - -test_that("thickness formatting works", { - expect_equal(vec_ptype_full(thickness()), "thickness") - expect_equal(vec_ptype_abbr(thickness()), "thk") - expect_equal(format(thickness()), character()) - expect_equal(format(thickness(1:2, 3, 4)), c("1thk [3,4]", "2thk [3,4]")) + geom_grob = layer_grob(p)[[1]] + slab_grob = geom_grob$children[[1]] + expect_equal(slab_grob$x, unit(c(0, 0.5, 1, 1, 0.5, 0), "native")) + # Inf should be squished to 0.9 and -Inf to 0 + expect_equal(slab_grob$y, unit(c(0, 0.9, 0, 0, 0, 0), "native")) }) -test_that("thickness casting works", { - expect_equal(vec_cast(thickness(2), double()), 2.0) - expect_equal(vec_cast(thickness(2L), integer()), 2L) - expect_equal(vec_cast(2.0, thickness()), thickness(2)) - expect_equal(vec_cast(2L, thickness()), thickness(2)) - - expect_equal(c(thickness(1), thickness(2)), thickness(c(1, 2))) - expect_equal(c(thickness(1), 2), thickness(c(1, 2))) - expect_equal(c(thickness(1), 2L), thickness(c(1, 2))) - expect_equal(vec_c(2, thickness(1)), thickness(c(2, 1))) - expect_equal(vec_c(2L, thickness(1)), thickness(c(2, 1))) - - expect_error(thickness(1) + character()) - - expect_equal(thickness(1) + thickness(2), thickness(3)) - expect_equal(thickness(1) - thickness(2), thickness(-1)) - expect_equal(thickness(1) / thickness(2), 0.5) - expect_error(thickness(1) * thickness(2)) - - expect_equal(thickness(2) * 3, thickness(6)) - expect_equal(thickness(1) / 2, thickness(0.5)) - expect_error(thickness(1) - 2) - expect_error(thickness(1) + 2) - - expect_equal(2 * thickness(3), thickness(6)) - expect_error(1 / thickness(2)) - expect_error(1 - thickness(2)) - expect_error(1 + thickness(2)) -}) - -test_that("thickness compatibility testing works", { - expect_equal(thickness(1) + thickness(2), thickness(3)) - expect_equal(thickness(1,1,NA) + thickness(2,NA,2), thickness(3,1,2)) - expect_equal(thickness(1,1,2) + thickness(2,1,2), thickness(3,1,2)) +# scale_type -------------------------------------------------------------- - expect_error(thickness(1,1,2) + thickness(2,0,2), class = "ggdist_incompatible_thickness_bounds") - expect_error(thickness(1,1,0) + thickness(2,1,2), class = "ggdist_incompatible_thickness_bounds") +test_that("scale_type works", { + expect_equal(scale_type(thickness(1)), "continuous") }) diff --git a/tests/testthat/test.subscale.R b/tests/testthat/test.subscale.R index 970ee2d9..e8467ce8 100755 --- a/tests/testthat/test.subscale.R +++ b/tests/testthat/test.subscale.R @@ -9,7 +9,7 @@ test_that("thickness subscale works", { expect_equal( subscale_thickness(c(0, NA, Inf, -Inf)), - thickness(c(0, NA_real_, 1, 0), NA_real_, NA_real_) + thickness(c(0, NA_real_, Inf, -Inf), NA_real_, NA_real_) ) expect_equal( @@ -36,11 +36,11 @@ test_that("thickness subscale works", { test_that("identity subscale works", { expect_equal( subscale_identity(c(0, NA, Inf, -Inf)), - thickness(c(0, NA_real_, 1, 0), NA_real_, NA_real_) + thickness(c(0, NA_real_, Inf, -Inf), NA_real_, NA_real_) ) expect_equal( subscale_identity(c(-3:3, NA_real_, Inf, -Inf)), - thickness(c(-3:3, NA_real_, 3, -3), NA_real_, NA_real_) + thickness(c(-3:3, NA_real_, Inf, -Inf), NA_real_, NA_real_) ) }) diff --git a/tests/testthat/test.thickness.R b/tests/testthat/test.thickness.R new file mode 100755 index 00000000..c06b24ee --- /dev/null +++ b/tests/testthat/test.thickness.R @@ -0,0 +1,57 @@ +# Tests for thickness datatype +# +# Author: mjskay +############################################################################### + +library(dplyr) +library(distributional) + + +# thickness type ---------------------------------------------------------- + +test_that("thickness formatting works", { + expect_equal(vec_ptype_full(thickness()), "thickness") + expect_equal(vec_ptype_abbr(thickness()), "thk") + expect_equal(format(thickness()), character()) + expect_equal(format(thickness(1:2, 3, 4)), c("1thk [3,4]", "2thk [3,4]")) +}) + +test_that("thickness casting works", { + expect_equal(vec_cast(thickness(2), double()), 2.0) + expect_equal(vec_cast(thickness(2L), integer()), 2L) + expect_equal(vec_cast(2.0, thickness()), thickness(2)) + expect_equal(vec_cast(2L, thickness()), thickness(2)) + + expect_equal(c(thickness(1), thickness(2)), thickness(c(1, 2))) + expect_equal(c(thickness(1), 2), thickness(c(1, 2))) + expect_equal(c(thickness(1), 2L), thickness(c(1, 2))) + + expect_equal(vec_c(2, thickness(1)), thickness(c(2, 1))) + expect_equal(vec_c(2L, thickness(1)), thickness(c(2, 1))) + + expect_error(thickness(1) + character()) + + expect_equal(thickness(1) + thickness(2), thickness(3)) + expect_equal(thickness(1) - thickness(2), thickness(-1)) + expect_equal(thickness(1) / thickness(2), 0.5) + expect_error(thickness(1) * thickness(2)) + + expect_equal(thickness(2) * 3, thickness(6)) + expect_equal(thickness(1) / 2, thickness(0.5)) + expect_error(thickness(1) - 2) + expect_error(thickness(1) + 2) + + expect_equal(2 * thickness(3), thickness(6)) + expect_error(1 / thickness(2)) + expect_error(1 - thickness(2)) + expect_error(1 + thickness(2)) +}) + +test_that("thickness compatibility testing works", { + expect_equal(thickness(1) + thickness(2), thickness(3)) + expect_equal(thickness(1,1,NA) + thickness(2,NA,2), thickness(3,1,2)) + expect_equal(thickness(1,1,2) + thickness(2,1,2), thickness(3,1,2)) + + expect_error(thickness(1,1,2) + thickness(2,0,2), class = "ggdist_incompatible_thickness_bounds") + expect_error(thickness(1,1,0) + thickness(2,1,2), class = "ggdist_incompatible_thickness_bounds") +})