tests/testthat/test-45-functions.R

In shades: Simple Colour Manipulation

context("Handling palette functions")

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")
    
    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)
    plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + lightness(scale_colour_viridis_d(), 50)
    expect_true(all(layer_data(plot)$colour %in% lightness(viridis(2), 50)))
    
    plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + opacity(scale_colour_viridis_d(), 0.5)
    expect_true(all(layer_data(plot)$colour %in% opacity(viridis(2), 0.5)))
    
    plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + complement(scale_colour_viridis_d())
    expect_true(all(layer_data(plot)$colour %in% complement(viridis(2),space="sRGB")))
    
    plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + addmix(scale_colour_viridis_d(), "red")
    expect_true(all(layer_data(plot)$colour %in% addmix(viridis(2), "red", space="sRGB")))
    
    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")))
})