Adding tests for buffers

R/create_buffers.R

@@ -22,7 +22,7 @@ create_buffers <- function(design, type, blocks = FALSE) {
 
         row <- c(rep(1, ncol+2), rep(nrow+2, ncol+2), rep(2:(nrow+1), 2))
         col <- c(rep(1:(ncol+2), 2), rep(1, nrow), rep(ncol+2, nrow))
-        n_brow <- length(row)  # Number of buffer rows
+        n_brow <- length(row)  # Number of rows to create in the buffer dataframe
         treatments <- rep("buffer", n_brow)
     }
     # Match row, rows, r
@@ -34,7 +34,7 @@ create_buffers <- function(design, type, blocks = FALSE) {
 
         row <- rep(seq(min_row-1, (2*nrow)+1, by = 2), each = ncol)
         col <- rep(seq(1, ncol),times = nrow+1)
-        n_brow <- length(row)  # Number of buffer rows
+        n_brow <- length(row)  # Number of rows to create in the buffer dataframe
         treatments <- rep("buffer", n_brow)
     }
     # Match col, cols, column, columns or c
@@ -45,8 +45,8 @@ create_buffers <- function(design, type, blocks = FALSE) {
         min_col <- min(design$col)
 
         row <- rep(seq(1, nrow), times = ncol+1)
-        col <- rep(seq(min_col, (2*ncol)+1, by = 2), each = nrow)
-        n_brow <- length(row)  # Number of buffer rows
+        col <- rep(seq(min_col-1, (2*ncol)+1, by = 2), each = nrow)
+        n_brow <- length(row)  # Number of rows to create in the buffer dataframe
         treatments <- rep("buffer", n_brow)
     }
     # Match double row, double rows, or dr
@@ -61,7 +61,7 @@ create_buffers <- function(design, type, blocks = FALSE) {
                  rep(seq(min_row+1, (3*nrow), by = 3),
                      each = ncol))
         col <- seq(min_col, ncol)
-        n_brow <- length(row)  # Number of buffer rows
+        n_brow <- length(row)  # Number of rows to create in the buffer dataframe
         treatments <- rep("buffer", n_brow)
     }
     # Match double col, double cols, double column, double columns, dc
@@ -76,7 +76,7 @@ create_buffers <- function(design, type, blocks = FALSE) {
                      each = nrow),
                  rep(seq(min_col+1, (3*ncol), by = 3),
                      each = nrow))
-        n_brow <- length(row)  # Number of buffer rows
+        n_brow <- length(col)  # Number of rows to create in the buffer dataframe
         treatments <- rep("buffer", n_brow)
     }
     # Match block, blocks, or b
@@ -98,7 +98,7 @@ create_buffers <- function(design, type, blocks = FALSE) {
         blocks_df <- stats::aggregate(cbind(row, col) ~ block, data = design, FUN = max)
         blocks_df$row[blocks_df$row==max(blocks_df$row)] <- max(blocks_df$row)+1
         blocks_df$col[blocks_df$col==max(blocks_df$col)] <- max(blocks_df$col)+1
-        for(i in max(blocks_df$block):1) {
+        for(i in max(as.numeric(blocks_df$block)):1) {
             buffers[buffers$row <= blocks_df$row[i]&buffers$col <= blocks_df$col[i],"block"] <- blocks_df$block[i]
         }
     }

tests/testthat/test-design.R

@@ -714,6 +714,87 @@ test_that("Invalid palette option produces error", {
     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("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)