Port tests to tinytest

inst/tinytest/test-05-shade.R

@@ -0,0 +1,34 @@
+# Create shade objects from various objects
+expect_error(shade(), "must not be empty")
+expect_error(shade(character(0)), "must not be empty")
+expect_stdout(print(shade("red")), "1 shade")
+expect_equal(space(shade("red")), "sRGB")
+expect_equivalent(coords("red"), matrix(c(1,0,0),nrow=1))
+expect_equivalent(shade(matrix(c(1,0,0),nrow=1)), shade("#FF0000"))
+# Using a factor to check the default initialisation method
+expect_equivalent(shade(factor(rep("red",3))), rep(shade("red"),3))
+
+if (requireNamespace("colorspace", quietly=TRUE))
+    expect_true(shade(colorspace::sRGB(1,0,0)) == "red")
+
+# Convert shade objects between spaces
+expect_equivalent(coords(warp("red","HSV")), matrix(c(0,1,1),nrow=1))
+expect_equivalent(round(coords(warp(shade("red"),"LAB"))), matrix(c(53,80,67),nrow=1))
+# Check that precision loss isn't too great when making a round-trip conversion
+shade <- shade(matrix(runif(3),nrow=1), space="sRGB")
+expect_equivalent(coords(warp(warp(shade,"HSV"),"sRGB")), coords(shade), tolerance=1e-4)
+
+# Index, combine and compare shade objects
+shades <- shade(c("red","green","blue"))
+expect_true(shades[1] == "red")
+shades[1] <- "darkred"
+expect_false(shades[1] == "red")
+
+expect_equal(c(shade("red"),shade("green")), shade(c("red","green")))
+expect_true(shade("red") != shade("green"))
+expect_true(shade("red") == shade(matrix(c(0,1,1),nrow=1),space="HSV"))
+expect_equal(space(c(shade("red"), shade(matrix(c(0,1,1),nrow=1),space="HSV"))), "XYZ")
+
+# expect_match exists in tinytest, but is broken in the current CRAN build
+expect_true(grepl("Mean colour distance is", all.equal(shade("red"),shade("green"))))
+expect_true(grepl("Lengths do not match", all.equal(shade("red"),shade(c("green","blue")))))

inst/tinytest/test-10-scales.R

@@ -0,0 +1,8 @@
+using("shades")
+
+# Create colour scales traversing different spaces
+expect_equal_shades(gradient(c("red","blue"),3), c("#FF0000","#800080","#0000FF"))
+expect_equal_shades(rev(gradient(c("red","blue"),3)), c("#0000FF","#800080","#FF0000"))
+expect_equal_shades(gradient(c("red","blue"),3,space="LAB"), c("#FF0000","#C90089","#0000FF"))
+expect_equal_shades(gradient("magma",3), c("#000004","#B63779","#FCFDBF"))
+expect_error(gradient("nothing",3), "should specify a predefined colour map")

inst/tinytest/test-15-properties.R

@@ -0,0 +1,30 @@
+using("shades")
+
+# Extract colour properties
+expect_equal(saturation("red"), 1)
+expect_equal(brightness("red"), 1)
+expect_equal(saturation("grey40"), 0)
+expect_equal(brightness(c("grey40","grey60")), c(0.4,0.6))
+expect_equal(round(chroma(c("black","white","red"))), c(0,0,105))
+expect_equal(round(lightness(c("black","white","red"))), c(0,100,53))
+
+# Manipulate colour properties
+expect_equal_shades(saturation("red",0.5), shade("#FF8080"))
+expect_equal_shades(brightness("red",0.5), shade("#800000"))
+expect_equal_shades(hue("red",delta(240)), shade("#0000FF"))
+expect_equal_shades(hue("blue",delta(240)), shade("#00FF00"))
+expect_equal_shades(lightness("red",scalefac(0.5)), shade("#A60000"))
+expect_equal_shades(brightness("red",scalefac(0.4,0.6)), c("#660000","#990000"))
+expect_equivalent(coords(brightness("grey40",c(0.2,0.6))), matrix(c(0,0,0,0,0.2,0.6),nrow=2))
+
+# Manipulate colour matrices and check dimensions
+shades <- shade(c("red","green","blue"))
+matrix <- rep(shades, 2)
+dim(matrix) <- c(3L,2L)
+
+expect_null(dim(brightness(shades,0.5)))
+expect_equal(length(brightness(shades,0.5)), 3L)
+expect_equal(dim(brightness(shades,c(0.4,0.6))), c(2L,3L))
+expect_equal_shades(brightness(shades,c(0.4,0.6)), c("#660000","#990000","#006600","#009900","#000066","#000099"))
+expect_equal(dim(brightness(matrix,c(0.4,0.6))), c(2L,3L,2L))
+expect_equal(dim(brightness(matrix,recycle(0.4,0.6))), c(3L,2L))

inst/tinytest/test-20-mixtures.R

@@ -0,0 +1,11 @@
+using("shades")
+
+# Colour mixing and complements
+expect_equivalent(coords(complement("cyan")), coords(shade("red")))
+expect_equal(complement("cyan",space="HSV"), warp("red","HSV"))
+expect_equal_shades(complement("cyan",space="Lab"), "#4F0002")
+
+expect_equivalent(addmix("blue","green"), shade("#00FFFF"))
+expect_equivalent(submix("cyan","yellow"), shade("#00FF00"))
+expect_equivalent("blue" %.)% "green", shade("#00FFFF"))
+expect_equivalent("cyan" %_/% "yellow", shade("#00FF00"))

inst/tinytest/test-25-distance.R

@@ -0,0 +1,2 @@
+expect_equal(round(distance(c("red","green","blue"),"red")), c(0,87,53))
+expect_error(distance("red", c("red","green","blue")), "Reference should be a single shade")

inst/tinytest/test-30-adaptation.R

@@ -0,0 +1,7 @@
+using("shades")
+
+primaries <- shade(c("red", "green", "blue"))
+expect_equal_shades(dichromat(primaries), c("#4D4222","#FFF600","#0027FF"))
+expect_equal_shades(dichromat(primaries,"protanopic"), c("#4D4222","#FFF600","#0027FF"))
+expect_equal_shades(dichromat(primaries,"deuteranopic"), c("#C5A700","#D0B335","#0068FE"))
+expect_equal_shades(dichromat(primaries,"tritanopic"), c("#FF0050","#00FBFF","#372828"))

inst/tinytest/test-35-swatch.R

@@ -0,0 +1,2 @@
+expect_null(swatch(c("red", "green", "blue")))
+expect_null(swatch(saturation(brightness(c("red", "green", "blue"), c(0.25,0.75)), c(0.25,0.75))))

inst/tinytest/test-40-alpha.R

@@ -0,0 +1,25 @@
+using("shades")
+
+expect_equal(opacity("red"), 1)
+expect_equal(opacity("#FF000080"), 128/255)
+expect_equal(opacity(saturation("#FF000080",0.5)), 128/255)
+expect_equal_shades(warp("#FF000080","HSV"), "#FF000080")
+
+expect_equal_shades(opacity("red",c(0,0.5)), c("#FF000000","#FF000080"))
+expect_equal_shades(opacity("red",delta(-0.5)), "#FF000080")
+expect_null(attr(opacity("#FF000080",delta(0.5)),"alpha"))
+
+shades <- shade(c("red","green","blue"))
+matrix <- rep(shades, 2)
+dim(matrix) <- c(3L,2L)
+
+expect_null(attr(shades,"alpha"))
+expect_equal(opacity(c(shades,"#00000000")), c(1,1,1,0))
+shades[2] <- "#00FF0000"
+expect_equal(attr(shades,"alpha"), c(1,0,1))
+expect_equal(dim(opacity(matrix,0.5)), c(3L,2L))
+expect_equal(dim(opacity(matrix,recycle(0.4,0.6))), c(3L,2L))
+
+expect_true(shade("#FF8080") == shade("#FF8080FF"))
+expect_false(shade("#FF8080") == shade("#FF8080DD"))
+expect_true(grepl("Alpha values do not match", all.equal(shade("#FF8080"), "#FF8080DD")))

tests/testthat/test-45-functions.R → inst/tinytest/test-45-functions.R

@@ -1,22 +1,18 @@
-context("Handling palette functions")
+viridis <- gradient("viridis")
+expect_equal(viridis(5L), gradient("viridis",5L))
 
-test_that("property methods can be applied to functions", {
-    viridis <- gradient("viridis")
-    expect_equal(viridis(5L), gradient("viridis",5L))
-
-    # The distinction is in the parentheses here: in one case lightness() is called on colours generated by the colour ramp; in the other, the ramp function is wrapped by lightness() and then called
-    expect_equal(lightness(viridis(5L)), lightness(viridis)(5L))
-    expect_equal(lightness(viridis(5L),50), lightness(viridis,50)(5L))
-
-    expect_equal(opacity(viridis(5L),0.5), opacity(viridis,0.5)(5L))
-    expect_equal(complement(viridis(5L)), complement(viridis)(5L))
-    expect_equal(addmix(viridis(5L),"red"), addmix(viridis,"red")(5L))
-    expect_equal(submix(viridis(5L),"red"), submix(viridis,"red")(5L))
-
-    skip_if_not_installed("ggplot2")
-
+# The distinction is in the parentheses here: in one case lightness() is called on colours generated by the colour ramp; in the other, the ramp function is wrapped by lightness() and then called
+expect_equal(lightness(viridis(5L)), lightness(viridis)(5L))
+expect_equal(lightness(viridis(5L),50), lightness(viridis,50)(5L))
+
+expect_equal(opacity(viridis(5L),0.5), opacity(viridis,0.5)(5L))
+expect_equal(complement(viridis(5L)), complement(viridis)(5L))
+expect_equal(addmix(viridis(5L),"red"), addmix(viridis,"red")(5L))
+expect_equal(submix(viridis(5L),"red"), submix(viridis,"red")(5L))
+
+if (requireNamespace("ggplot2", quietly=TRUE))
+{
     library(ggplot2)
-
     data <- data.frame(sex=c("M","M","F","F"), age=c(23,34,28,26), height=c(180,168,159,170))
 
     # This relies on scales::viridis_pal (at time of writing) agreeing with our viridis scale, but this seems less fragile than assuming that scales and ggplot2 continue to interact the way they do now (and adding another suggested dependency)
@@ -34,4 +30,4 @@ test_that("property methods can be applied to functions", {
 
     plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + submix(scale_colour_viridis_d(), "red")
     expect_true(all(layer_data(plot)$colour %in% submix(viridis(2), "red", space="sRGB")))
-})
+}

inst/tinytest/test-50-missing.R

@@ -0,0 +1,19 @@
+using("shades")
+
+# Missing shade handling
+shades <- gradient(c("red","blue"), 3)
+shades[2] <- NA
+
+expect_equal(is.na(shades), c(FALSE,TRUE,FALSE))
+expect_true(all(is.na(coords(shades)[2,])))
+expect_equal(saturation(shades), c(1,NA,1))
+expect_equal_shades(saturation(shades,0.5), shade(c("#FF8080",NA,"#8080FF")))
+expect_equivalent(is.na(saturation(shades, c(0,0.5,1))), matrix(c(FALSE,TRUE,FALSE),3,3,byrow=TRUE))
+expect_equivalent(complement(shades), shade(c("#00FFFF",NA,"#FFFF00")))
+expect_equivalent(dichromat(shades)[2], shade(NA))
+expect_equal_shades(opacity(shades,0.5), c("#FF000080",NA,"#0000FF80"))
+
+# NAs as new property values should lead to pass-through
+expect_equal(saturation(saturation("olivedrab",NA)), saturation("olivedrab"))
+expect_equal_shades(opacity("red",NA), "red")
+expect_equal_shades(opacity("red",c(0,NA,1)), c("#FF000000","#FF0000FF","#FF0000FF"))

tests/tinytest.R

@@ -0,0 +1,2 @@
+if (requireNamespace("tinytest", quietly=TRUE))
+    tinytest::test_package("shades")