test_that("CRD designs are supported", { # CRD d1 <- design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = 42, quiet = TRUE) expect_equal(names(d1), c("design", "plot.des", "satab", "seed")) expect_equal(d1$seed, 42) expect_equal(d1$satab[4], "Residual 16\n") expect_snapshot_output(d1$satab) vdiffr::expect_doppelganger(title = "CRD plot produced", autoplot(d1)) }) test_that("RCBD designs are supported", { # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE) expect_equal(d2$seed, 42) expect_equal(d2$satab[3], "Block stratum 3\n") expect_snapshot_output(d2$satab) vdiffr::expect_doppelganger(title = "RCBD plot produced", autoplot(d2)) }) test_that("RCBD with row-wise blocks are supported", { # RCBD with row-wise blocks d2.1 <- design("rcbd", treatments = LETTERS[1:6], reps = 4, nrows = 4, ncols = 6, brows = 1, bcols = 6, seed = 42, quiet = TRUE) vdiffr::expect_doppelganger(title = "RCBD with row blocks", autoplot(d2.1)) }) test_that("RCBD with square blocks are supported", { d2.2 <- design("rcbd", treatments = LETTERS[1:6], reps = 4, nrows = 6, ncols = 4, brows = 3, bcols = 2, seed = 42, quiet = TRUE) vdiffr::expect_doppelganger(title = "RCBD with square blocks", autoplot(d2.2)) }) test_that("LSD designs are supported", { # LSD d3 <- design(type = "lsd", c("S1", "S2", "S3", "S4"), nrows = 4, ncols = 4, seed = 42, quiet = TRUE) expect_equal(d3$seed, 42) expect_equal(d3$satab[6], "Residual 6\n") expect_snapshot_output(d3$satab) vdiffr::expect_doppelganger(title = "LSD plot produced", autoplot(d3)) }) test_that("Split plot designs are supported", { # Split d4 <- design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 8, bcols = 1, seed = 42, quiet = TRUE) expect_equal(d4$seed, 42) expect_equal(d4$satab[11], " treatments:sub_treatments 3\n") expect_snapshot_output(d4$satab) vdiffr::expect_doppelganger(title = "Split plot produced", autoplot(d4)) }) test_that("Split plot designs with names are supported", { d4.1 <- design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 4, bcols = 2, seed = 42, fac.names = list(Water = c("Irrigated", "Rain-fed"), N = seq(50, 200, 50)), quiet = TRUE) expect_equal(d4.1$satab[11], " Water:N 3\n") expect_snapshot_output(d4.1$satab) vdiffr::expect_doppelganger(title = "Split plot with names", autoplot(d4.1)) }) test_that("Split plot designs with double row blocks are supported", { d4.2 <- design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 1, bcols = 4, seed = 42, quiet = TRUE) expect_equal(d4.2$satab[11], " treatments:sub_treatments 3\n") expect_equal(d4.2$seed, 42) vdiffr::expect_doppelganger(title = "Split plot double row blocks", autoplot(d4.2)) }) test_that("Split plot designs with ntrt == bcol are supported", { d4.3 <- design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 4, ncols = 8, brows = 1, bcols = 8, seed = 42, quiet = TRUE) expect_equal(d4.3$satab[11], " treatments:sub_treatments 3\n") expect_equal(d4.3$seed, 42) vdiffr::expect_doppelganger(title = "Split plot ntrt == bcol", autoplot(d4.3)) }) test_that("Split plot designs with column-wise arrangement are supported", { d4.4 <- design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 4, bcols = 2, byrow = FALSE, seed = 42, quiet = TRUE) expect_equal(d4.4$satab[11], " treatments:sub_treatments 3\n") expect_equal(d4.4$seed, 42) vdiffr::expect_doppelganger(title = "Split plot byrow = F", autoplot(d4.4)) }) test_that("Crossed CRD designs are supported", { # Crossed, CRD d5 <- design(type = "crossed:crd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, seed = 42, fac.sep = c("", ""), quiet = TRUE) expect_equal(d5$seed, 42) expect_equal(d5$satab[5], "A:B 2\n") expect_snapshot_output(d5$satab) vdiffr::expect_doppelganger(title = "Factorial CRD plot no space sep", autoplot(d5)) # Crossed, CRD with renaming d5.1 <- design(type = "crossed:crd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, seed = 42, fac.names = list(N = c(50, 100, 150), Water = c("Irrigated", "Rain-fed")), quiet = TRUE) expect_equal(d5.1$satab[5], "N:Water 2\n") expect_snapshot_output(d5.1$satab) vdiffr::expect_doppelganger(title = "Factorial CRD with names", autoplot(d5.1)) }) test_that("Crossed RCBD designs are supported", { # Crossed RCBD d6 <- design(type = "crossed:rcbd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, brows = 6, bcols = 1, seed = 42, quiet = TRUE) expect_equal(d6$seed, 42) expect_equal(d6$satab[8], "Residual 10\n") expect_snapshot_output(d6$satab) vdiffr::expect_doppelganger(title = "Factorial RCBD plot produced", autoplot(d6)) }) test_that("Crossed RCBD designs with row blocks are supported", { d6.1 <- design(type = "crossed:rcbd", treatments = c(3, 2), reps = 3, nrows = 3, ncols = 6, brows = 1, bcols = 6, fac.sep = c(":", ""), seed = 42, quiet = TRUE) expect_equal(d6.1$satab[8], "Residual 10\n") vdiffr::expect_doppelganger(title = "Factorial RCBD plot with row blocks", autoplot(d6.1)) }) test_that("Crossed RCBD designs with double row blocks are supported", { d6.2 <- design(type = "crossed:rcbd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, brows = 2, bcols = 3, seed = 42, quiet = TRUE) expect_equal(d6.2$satab[8], "Residual 10\n") vdiffr::expect_doppelganger(title = "Factorial RCBD plot double row blocks", autoplot(d6.2)) }) test_that("Crossed RCBD designs with double row blocks are supported", { d6.3 <- design(type = "crossed:rcbd", treatments = c(3, 2), reps = 4, nrows = 6, ncols = 4, brows = 3, bcols = 2, seed = 42, quiet = TRUE) vdiffr::expect_doppelganger(title = "Factorial RCBD plot square blocks", autoplot(d6.3)) }) test_that("Crossed LSD designs are supported", { # Crossed LSD with separator d7 <- design(type = "crossed:lsd", treatments = c(3, 2), nrows = 6, ncols = 6, fac.sep = "_", seed = 42, quiet = TRUE) expect_equal(d7$seed, 42) expect_equal(d7$satab[3], "Row 5\n") expect_snapshot_output(d7$satab) vdiffr::expect_doppelganger(title = "Factorial LSD plot with sep", autoplot(d7)) }) test_that("Crossed LSD designs with names are supported", { d7.1 <- design(type = "crossed:lsd", treatments = c(3, 2), nrows = 6, ncols = 6, seed = 42, quiet = TRUE, fac.names = list(N = c(50, 100, 150), W = c("I", "R"))) expect_equal(d7.1$seed, 42) expect_equal(d7.1$satab[3], "Row 5\n") vdiffr::expect_doppelganger(title = "Factorial LSD with names", autoplot(d7.1)) }) test_that("Crossed LSD designs with names and separator are supported", { d7.2 <- design(type = "crossed:lsd", treatments = c(3, 2), nrows = 6, ncols = 6, seed = 42, quiet = TRUE, fac.names = list(N = c(50, 100, 150), W = c("I", "R")), fac.sep = c(":", "")) expect_equal(d7.2$seed, 42) expect_equal(d7.2$satab[3], "Row 5\n") vdiffr::expect_doppelganger(title = "Factorial LSD plot names and sep", autoplot(d7.2)) }) test_that("Nested designs are supported", { # Nested LSD d8 <- design(type = "lsd", treatments = c("A1", "A2", "A3", "A4", "B1", "B2", "B3"), nrows = 7, ncols = 7, seed = 42, quiet = TRUE) expect_equal(d8$seed, 42) expect_equal(d8$satab[6], "Residual 30\n") expect_snapshot_output(d8$satab) vdiffr::expect_doppelganger(title = "Nested LSD", autoplot(d8)) }) test_that("3 way factorial designs are possible", { d9 <- design(type = "crossed:crd", treatments = c(2, 2, 2), reps = 3, nrows = 6, ncols = 4, seed = 42, quiet = TRUE) expect_equal(d9$seed, 42) expect_equal(d9$satab[6], "A:B:C 1\n") expect_snapshot_output(d9$satab) vdiffr::expect_doppelganger(title = "3 way factorial", autoplot(d9)) d9.1 <- design(type = "crossed:crd", treatments = c(2, 2, 2), reps = 3, nrows = 6, ncols = 4, seed = 42, fac.names = list(X = c("A", "B"), Y = 1:2, Z = c(10, 20))) expect_equal(d9.1$seed, 42) expect_equal(d9.1$satab[6], "X:Y:Z 1\n") expect_snapshot_output(d9.1$satab) vdiffr::expect_doppelganger(title = "3 way factorial with names", autoplot(d9.1)) d9.2 <- design(type = "crossed:rcbd", treatments = c(2, 2, 2), reps = 3, nrows = 8, ncols = 3, brows = 8, bcols = 1, seed = 42, fac.names = list(X = c("A", "B"), Y = 1:2, Z = c(10, 20))) expect_equal(d9.2$seed, 42) expect_equal(d9.2$satab[3], "Block stratum 2\n") expect_snapshot_output(d9.2$satab) vdiffr::expect_doppelganger(title = "3 way rcbd factorial with names", autoplot(d9.2)) }) test_that("Adding names to 3 way factorial designs works", { d9.2 <- design(type = "crossed:rcbd", treatments = c(2, 2, 2), reps = 3, nrows = 8, ncols = 3, brows = 8, bcols = 1, seed = 42, fac.names = list(X = c("A", "B"), Y = 1:2, Z = c(10, 20))) expect_equal(d9.2$seed, 42) expect_equal(d9.2$satab[3], "Block stratum 2\n") expect_snapshot_output(d9.2$satab) vdiffr::expect_doppelganger(title = "3 way rcbd factorial with names", autoplot(d9.2)) }) test_that("seed options work", { # seed = TRUE d1 <- design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = TRUE, quiet = TRUE) expect_true(is.numeric(d1$seed)) # seed = value d2 <- design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = 123, quiet = TRUE) expect_identical(d2$seed, 123) # seed = FALSE d3 <- design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = FALSE, quiet = TRUE) expect_null(d3$seed) expect_equal(names(d3), c("design", "plot.des", "satab")) }) # Testing messages, warnings and errors test_that("Invalid seed options give errors or warnings", { # seed = NA expect_error(design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = NA, quiet = TRUE), "seed must be numeric or TRUE/FALSE") # seed = NULL expect_error(design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = NULL, quiet = TRUE), "argument is of length zero") # seed = "ABC" expect_error(design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = "ABC", quiet = TRUE), "seed must be numeric or TRUE/FALSE") # seed is vector of numbers # expect_warning( # expect_warning( # expect_warning(d1 <- design(type = "crd", treatments = c(1, 5, 10, 20), # reps = 5, nrows = 4, ncols = 5, seed = 1:10, quiet = TRUE), # "the condition has length > 1 and only the first element will be used"), # "the condition has length > 1 and only the first element will be used"), # "the condition has length > 1 and only the first element will be used") # expect_true(is.numeric(d1$seed)) # expect_equal(d1$seed, 1) # expect_warning( # expect_error(design(type = "crd", treatments = c(1, 5, 10, 20), # reps = 5, nrows = 4, ncols = 5, seed = c('a', 'b'), quiet = TRUE), # "seed must be numeric or TRUE/FALSE"), # "the condition has length > 1 and only the first element will be used") }) test_that("reps in lsd produces a message", { expect_message(x <- design(type = "lsd", 1:4, reps = 3, nrows = 4, ncols = 4, seed = 42, quiet = TRUE), "Number of replicates is not required for Latin Square designs and has been ignored") }) test_that("rcbd requires brows and bcols", { expect_error(design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = NA, bcols = 1, seed = 42), "Design has blocks so brows and bcols must be supplied.") expect_error(design(type = "crossed:rcbd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, brows = NA, bcols = 1), "Design has blocks so brows and bcols must be supplied.") }) test_that("unsupported design types give an error", { expect_error(design(type = "abc", 1:4, reps = 5, nrows = 4, ncols = 5, seed = 42), "Designs of type 'abc' are not supported") expect_error(design(type = "strip", 1:4, reps = 5, nrows = 4, ncols = 5, seed = 42), "Designs of type 'strip' are not supported") expect_error(design(type = "crossed:split", 1:4, reps = 5, nrows = 4, ncols = 5, seed = 42), "Crossed designs of type 'split' are not supported") expect_error(design(type = "crossed:abc", 1:4, reps = 5, nrows = 4, ncols = 5, seed = 42), "Crossed designs of type 'abc' are not supported") expect_error(design(type = "crossed:crd", treatments = 1:4, reps = 5, nrows = 4, ncols = 5, seed = 42), "Crossed designs with more than three treatment factors are not supported") }) test_that("split plot requires sub_treatments", { expect_error(design(type = "split", treatments = c("A", "B"), sub_treatments = NULL, reps = 4, nrows = 8, ncols = 4, brows = 4, bcols = 2, seed = 42), "sub_treatments are required for a split plot design") }) test_that("split plot requires brows and bcols", { expect_error(design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = NA, bcols = 2, seed = 42), "Design has blocks so brows and bcols must be supplied.") }) test_that("split plot allows a character vector for factor names", { # Split with vector of names d11 <- design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 4, bcols = 2, seed = 42, fac.names = c("Water", "Nitrogen"), quiet = TRUE) expect_equal(d11$satab[11], " Water:Nitrogen 3\n") expect_snapshot_output(d11$satab) vdiffr::expect_doppelganger(title = "Split plot with vector names", autoplot(d11)) }) test_that("split plot produces warning when incorrect number of treatment labels given", { expect_warning(design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 4, bcols = 2, seed = 42, fac.names = list(Water = "ABC", N = 1:4)), "Water must contain the correct number of elements. Elements have not been applied.") expect_warning(design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 4, bcols = 2, seed = 42, fac.names = list(Water = c("A", "B"), N = 1:10)), "N must contain the correct number of elements. Elements have not been applied.") expect_warning(design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 4, bcols = 2, seed = 42, fac.names = list(Water = c("A", "B"), N = 1:4, Another = 1:5)), "fac.names contains 3 elements but only the first 2 have been used.") expect_warning(design(type = "split", treatments = c("A", "B"), sub_treatments = 1:4, reps = 4, nrows = 8, ncols = 4, brows = 4, bcols = 2, seed = 42, fac.names = list(Water = c("A", "B"))), "fac.names doesn't contain enough elements and has not been used.") }) test_that("factorial designs produce warnings when incorrect number of treatment labels given", { expect_warning(design(type = "crossed:rcbd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, brows = 6, bcols = 1, fac.names = list(Water = c("A", "B"), N = 1:2), quiet = TRUE), "Water must contain the correct number of elements. Elements have not been applied.") expect_warning(design(type = "crossed:rcbd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, brows = 6, bcols = 1, fac.names = list(Water = c("A", "B", "C"), N = 1), quiet = TRUE), "N must contain the correct number of elements. Elements have not been applied.") expect_warning(design(type = "crossed:rcbd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, brows = 6, bcols = 1, fac.names = list(Water = c("A", "B", "C"), N = 1:2, Another = 1:10), quiet = TRUE), "fac.names contains 3 elements but only the first 2 have been used.") expect_warning(design(type = "crossed:rcbd", treatments = c(3, 2), reps = 3, nrows = 6, ncols = 3, brows = 6, bcols = 1, fac.names = list(Water = c("A", "B", "C")), quiet = TRUE), "fac.names doesn't contain enough elements and has not been used.") expect_warning(design(type = "crossed:crd", treatments = c(2, 2, 2), reps = 3, nrows = 6, ncols = 4, fac.names = list(Water = c("A", "B"), N = 1:2, Another = 1), quiet = TRUE), "Another must contain the correct number of elements. Elements have not been applied.") }) test_that("passing unknown arguments to ggsave causes an error", { expect_error(design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = 42, Width = 6, quiet = TRUE), NULL) }) test_that("Area and treatment size mismatches produce warnings", { # Wrap this in supressWarnings to hide other warning message suppressWarnings(expect_warning( design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 50, seed = 42, quiet = TRUE), "Area provided is larger than treatments applied. Please check inputs." )) expect_warning( design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 2, ncols = 5, seed = 42, quiet = TRUE), "Area provided is smaller than treatments applied. Please check inputs." ) }) test_that("Invalid save option produces an error", { expect_error(design("crd", treatments = 1:11, reps = 4, nrows = 11, ncols = 4, save = "abc", quiet = TRUE), "save must be one of 'none'/FALSE, 'both'/TRUE, 'plot', or 'workbook'." ) }) test_that("save = 'none' produces nothing", { design("crd", treatments = 1:11, reps = 4, nrows = 11, ncols = 4, save = "none", quiet = TRUE) expect_false(file.exists("crd_design.csv")) expect_false(file.exists("crd_design.pdf")) }) test_that("save = FALSE produces nothing", { design("crd", treatments = 1:11, reps = 4, nrows = 11, ncols = 4, save = FALSE, quiet = TRUE) expect_false(file.exists("crd_design.csv")) expect_false(file.exists("crd_design.pdf")) }) test_that("save = 'workbook' produces csv file and not plot", { design("crd", treatments = 1:11, reps = 4, nrows = 11, ncols = 4, save = "workbook", savename = "crd_design1", quiet = TRUE) withr::local_file("crd_design1.csv") expect_true(file.exists("crd_design1.csv")) expect_snapshot_file("crd_design1.csv") expect_false(file.exists("crd_design1.pdf")) }) test_that("save = 'plot' produces plot file and not csv", { design("crd", treatments = 1:11, reps = 4, nrows = 11, ncols = 4, save = "plot", savename = "crd_design2", quiet = TRUE) withr::local_file("crd_design2.pdf") expect_false(file.exists("crd_design2.csv")) expect_true(file.exists("crd_design2.pdf")) }) test_that("save = 'both' produces plot file and csv", { design("crd", treatments = 1:11, reps = 4, nrows = 11, ncols = 4, save = "both", savename = "crd_design3", quiet = TRUE) withr::local_file("crd_design3.pdf") withr::local_file("crd_design3.csv") expect_true(file.exists("crd_design3.csv")) expect_true(file.exists("crd_design3.pdf")) expect_snapshot_file("crd_design3.csv") }) test_that("save = TRUE produces plot file and csv", { design("crd", treatments = 1:11, reps = 4, nrows = 11, ncols = 4, save = TRUE, savename = "crd_design4", quiet = TRUE) withr::local_file("crd_design4.pdf") withr::local_file("crd_design4.csv") expect_true(file.exists("crd_design4.csv")) expect_true(file.exists("crd_design4.pdf")) expect_snapshot_file("crd_design4.csv") }) test_that("designs have a class of 'design'", { d1 <- design("crd", treatments = 1:11, reps = 4, nrows = 11, ncols = 4, quiet = TRUE) expect_s3_class(d1, "design") }) test_that("brows or bcols larger than nrows or ncols gives an error", { expect_error(design("rcbd", treatments = 1:4, reps = 4, nrows = 4, ncols = 4, brows = 5, bcols = 1, quiet = TRUE), "brows must not be larger than nrows") expect_error(design("rcbd", treatments = 1:4, reps = 4, nrows = 4, ncols = 4, brows = 1, bcols = 5, quiet = TRUE), "bcols must not be larger than ncols") }) test_that("size argument must be numeric", { expect_error(design("crd", treatments = 1:4, reps = 4, nrows = 4, ncols = 4, size = "A", quiet = TRUE), "size must be numeric") expect_error(design("crd", treatments = 1:4, reps = 4, nrows = 4, ncols = 4, size = TRUE, quiet = TRUE), "size must be numeric") }) test_that("plot = FALSE does not produce a plot, but autoplot does", { d1 <- design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = 42, quiet = TRUE, plot = FALSE) expect_equal(names(d1), c("design", "satab", "seed")) expect_null(d1$plot.des) vdiffr::expect_doppelganger(title = "Plot produced with plot = FALSE", autoplot(d1)) }) test_that("autoplot responds to margin argument", { d1 <- design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = 42, quiet = TRUE) vdiffr::expect_doppelganger(title = "autoplot with margin", autoplot(d1, margin = TRUE)) }) test_that("autoplot responds to rotation argument", { d1 <- design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = 42, quiet = TRUE) vdiffr::expect_doppelganger(title = "autoplot with rotation", autoplot(d1, rotation = 90)) }) test_that("autoplot responds to size argument", { d1 <- design(type = "crd", treatments = c(1, 5, 10, 20), reps = 5, nrows = 4, ncols = 5, seed = 42, quiet = TRUE) vdiffr::expect_doppelganger(title = "autoplot with size", autoplot(d1, size = 8)) }) test_that("Colour blind friendly plots work", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) expect_snapshot_output(d1$satab) expect_snapshot_output(d2$satab) vdiffr::expect_doppelganger(title = "CRD colour blind", autoplot(d1, palette = "colour blind")) vdiffr::expect_doppelganger(title = "RCBD colour blind", autoplot(d2, palette = "cb")) }) test_that("Colour blind friendly viridis", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) vdiffr::expect_doppelganger(title = "CRD colour blind viridis", autoplot(d1, palette = "viridis")) vdiffr::expect_doppelganger(title = "RCBD colour blind viridis", autoplot(d2, palette = "viridis")) }) test_that("Colour blind friendly magma", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) vdiffr::expect_doppelganger(title = "CRD colour blind magma", autoplot(d1, palette = "magma")) vdiffr::expect_doppelganger(title = "RCBD colour blind magma", autoplot(d2, palette = "magma")) }) test_that("Colour blind friendly inferno", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) vdiffr::expect_doppelganger(title = "CRD colour blind inferno", autoplot(d1, palette = "inferno")) vdiffr::expect_doppelganger(title = "RCBD colour blind inferno", autoplot(d2, palette = "inferno")) }) test_that("Colour blind friendly plasma", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) vdiffr::expect_doppelganger(title = "CRD colour blind plasma", autoplot(d1, palette = "plasma")) vdiffr::expect_doppelganger(title = "RCBD colour blind plasma", autoplot(d2, palette = "plasma")) }) test_that("Colour blind friendly cividis", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) vdiffr::expect_doppelganger(title = "CRD colour blind cividis", autoplot(d1, palette = "cividis")) vdiffr::expect_doppelganger(title = "RCBD colour blind cividis", autoplot(d2, palette = "cividis")) }) test_that("Various colour blind spellings and options", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) vdiffr::expect_doppelganger(title = "CRD colour blind option1", autoplot(d1, palette = "colour-blind")) vdiffr::expect_doppelganger(title = "CRD colour blind option2", autoplot(d1, palette = "colour blind")) vdiffr::expect_doppelganger(title = "CRD colour blind option3", autoplot(d1, palette = "colour_blind")) vdiffr::expect_doppelganger(title = "CRD colour blind option4", autoplot(d1, palette = "colour.blind")) vdiffr::expect_doppelganger(title = "CRD colour blind option5", autoplot(d1, palette = "colourblind")) vdiffr::expect_doppelganger(title = "CRD color blind option1", autoplot(d1, palette = "color-blind")) vdiffr::expect_doppelganger(title = "CRD color blind option2", autoplot(d1, palette = "color blind")) vdiffr::expect_doppelganger(title = "CRD color blind option3", autoplot(d1, palette = "color_blind")) vdiffr::expect_doppelganger(title = "CRD color blind option4", autoplot(d1, palette = "color.blind")) vdiffr::expect_doppelganger(title = "CRD color blind option5", autoplot(d1, palette = "colorblind")) vdiffr::expect_doppelganger(title = "RCBD colour blind option1", autoplot(d2, palette = "colour-blind")) vdiffr::expect_doppelganger(title = "RCBD color blind option1", autoplot(d2, palette = "color-blind")) }) test_that("Alternative palettes work", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) vdiffr::expect_doppelganger(title = "CRD RdBu palette", autoplot(d1, palette = "RdBu")) vdiffr::expect_doppelganger(title = "CRD Set3 palette", autoplot(d1, palette = "Set3")) vdiffr::expect_doppelganger(title = "CRD Paired palette", autoplot(d1, palette = "Paired")) vdiffr::expect_doppelganger(title = "RCBD RdBu palette", autoplot(d2, palette = "RdBu")) vdiffr::expect_doppelganger(title = "RCBD Set3 palette", autoplot(d2, palette = "Set3")) vdiffr::expect_doppelganger(title = "RCBD Paired palette", autoplot(d2, palette = "Paired")) }) test_that("Invalid palette option produces error", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) expect_error(autoplot(d1, palette = "abc"), "Invalid value for palette.") expect_error(autoplot(d1, palette = "set3"), "Invalid value for palette.") expect_error(autoplot(d1, palette = "spectral"), "Invalid value for palette.") }) test_that("Adding buffers to plots works", { # CRD d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) expect_equal(length(unique(d1$design$row)), 11) expect_equal(length(unique(d1$design$col)), 4) vdiffr::expect_doppelganger(title = "Row buffers", autoplot(d1, buffer = "row")) vdiffr::expect_doppelganger(title = "Column buffers", autoplot(d1, buffer = "column")) vdiffr::expect_doppelganger(title = "Edge buffers", autoplot(d1, buffer = "edge")) vdiffr::expect_doppelganger(title = "Double row buffers", autoplot(d1, buffer = "double row")) vdiffr::expect_doppelganger(title = "Double Column buffers", autoplot(d1, buffer = "double column")) }) test_that("Adding buffers to plots works for RCBD", { # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) expect_equal(length(unique(d2$design$row)), 11) expect_equal(length(unique(d2$design$col)), 4) vdiffr::expect_doppelganger(title = "Row buffers RCBD", autoplot(d2, buffer = "row")) vdiffr::expect_doppelganger(title = "Column buffers RCBD", autoplot(d2, buffer = "column")) vdiffr::expect_doppelganger(title = "Edge buffers RCBD", autoplot(d2, buffer = "edge")) vdiffr::expect_doppelganger(title = "Double row buffers RCBD", autoplot(d2, buffer = "double row")) vdiffr::expect_doppelganger(title = "Double Column buffers RCBD", autoplot(d2, buffer = "double column")) }) test_that("Invalid buffer options produce an error", { # RCBD d2 <- design("rcbd", treatments = LETTERS[1:11], reps = 4, nrows = 11, ncols = 4, brows = 11, bcols = 1, seed = 42, quiet = TRUE, plot = FALSE) expect_error(autoplot(d2, buffer = "block"), "Block buffers are not yet supported\\.") expect_error(autoplot(d2, buffer = "abc"), "Invalid buffer option: abc") }) # test_that("Buffers are produced when abreviations are given", { # # CRD # d1 <- design("crd", treatments = LETTERS[1:11], reps = 4, # nrows = 11, ncols = 4, seed = 42, quiet = TRUE, plot = FALSE) # # withr:::local_file("full_argument.png") # withr:::local_file("abbr_argument.png") # ggsave(plot = autoplot(d1, buffer = "row"), filename = "full_argument.svg", width = 5, height = 3) # ggsave(plot = autoplot(d1, buffer = "r"), filename = "abbr_argument.png", width = 5, height = 3) # compare_file_binary("full_argument.png", "abbr_argument.png") # # withr:::local_file("full_argument.png") # withr:::local_file("abbr_argument.png") # ggsave(plot = autoplot(d1, buffer = "row"), filename = "full_argument.png", width = 5, height = 3) # ggsave(plot = autoplot(d1, buffer = "rows"), filename = "abbr_argument.png", width = 5, height = 3) # compare_file_binary("full_argument.png", "abbr_argument.png") # # withr:::local_file("full_argument.png") # withr:::local_file("abbr_argument.png") # ggsave(plot = autoplot(d1, buffer = "column"), filename = "full_argument.png", width = 5, height = 3) # ggsave(plot = autoplot(d1, buffer = "columns"), filename = "abbr_argument.png", width = 5, height = 3) # compare_file_binary("full_argument.png", "abbr_argument.png") # # withr:::local_file("full_argument.png") # withr:::local_file("abbr_argument.png") # ggsave(plot = autoplot(d1, buffer = "column"), filename = "full_argument.png", width = 5, height = 3) # ggsave(plot = autoplot(d1, buffer = "col"), filename = "abbr_argument.png", width = 5, height = 3) # compare_file_binary("full_argument.png", "abbr_argument.png") # # withr:::local_file("full_argument.png") # withr:::local_file("abbr_argument.png") # ggsave(plot = autoplot(d1, buffer = "column"), filename = "full_argument.png", width = 5, height = 3) # ggsave(plot = autoplot(d1, buffer = "cols"), filename = "abbr_argument.png", width = 5, height = 3) # compare_file_binary("full_argument.png", "abbr_argument.png") # # withr:::local_file("full_argument.png") # withr:::local_file("abbr_argument.png") # ggsave(plot = autoplot(d1, buffer = "column"), filename = "full_argument.png", width = 5, height = 3) # ggsave(plot = autoplot(d1, buffer = "c"), filename = "abbr_argument.png", width = 5, height = 3) # compare_file_binary("full_argument.png", "abbr_argument.png") # # }) test_that("Ability to provide arbitrary column names for plotting works", { des <- expand.grid(ro = 1:4, co = 1:5) des$bl <- des$co set.seed(42) des$treat <- sample(rep(LETTERS[1:4], times = 5)) class(des) <- c("design", class(des)) vdiffr::expect_doppelganger(title = "Quoted column names without blocks", autoplot(des, row = "ro", column = "co", treatments = "treat")) vdiffr::expect_doppelganger(title = "Quoted column names with blocks", autoplot(des, row = "ro", column = "co", treatments = "treat")) }) test_that("Arbitrary unquoted column names for plotting works", { des <- expand.grid(ro = 1:4, co = 1:5) des$bl <- des$ro set.seed(42) des$treat <- sample(rep(LETTERS[1:5], times = 4)) class(des) <- c("design", class(des)) vdiffr::expect_doppelganger(title = "NSE of column names without blocks", autoplot(des, row = ro, column = co, treatments = treat)) vdiffr::expect_doppelganger(title = "NSE of column names with blocks", autoplot(des, row = ro, column = co, block = bl, treatments = treat)) })