Handling blocks with buffers

R/autoplot.R

@@ -153,19 +153,22 @@ autoplot.design <- function(object, rotation = 0, size = 4, margin = FALSE, pale
             block = sort(unique(object$block)),
             xmin = 0, xmax = 0, ymin = 0, ymax = 0
         )
+        if(!missing(buffer)) {
+            object <- create_buffers(object, type = buffer, blocks = TRUE)
+            if("buffer" %in% levels(object$treatments)) {
+                colour_palette <- c(colour_palette, "white")
+            }
+        }
         for (i in 1:nrow(blkdf)) {
-            item <- blkdf$block[i]
-            tmp <- object[object$block == item, ]
+            tmp <- object[object$block == blkdf$block[i], ]
             blkdf[i, "ymin"] <- (min(tmp$row) - 0.5)
             blkdf[i, "ymax"] <- (max(tmp$row) + 0.5)
             blkdf[i, "xmin"] <- (min(tmp$col) - 0.5)
             blkdf[i, "xmax"] <- (max(tmp$col) + 0.5)
         }
-        if(!missing(buffer)) {
 
-        }
         plt <- ggplot2::ggplot(...) +
-            ggplot2::geom_tile(data = object, mapping = ggplot2::aes(x = col, y = row, fill = treatments), colour = "black", ...) +
+            ggplot2::geom_tile(data = object, mapping = ggplot2::aes(x = col, y = row, fill = treatments), colour = "black") +
             ggplot2::geom_text(data = object, mapping = ggplot2::aes(x = col, y = row, label = treatments), colour = object$text_col, angle = rotation, size = size, ...) +
             ggplot2::geom_rect(
                 data = blkdf,

R/create_buffers.R

@@ -2,10 +2,11 @@
 #'
 #' @param design The data frame of the design.
 #' @param type The type of buffer. One of edge, row, column, double row, double column, or block (coming soon).
+#' @param blocks Does the design data frame contain blocks?
 #'
 #' @return The original data frame, updated to include buffers
 #' @keywords internal
-create_buffers <- function(design, type) {
+create_buffers <- function(design, type, blocks = FALSE) {
     nrow <- max(design$row)
     ncol <- max(design$col)
 
@@ -65,12 +66,22 @@ create_buffers <- function(design, type) {
         stop("Invalid buffer option: ", type, call. = FALSE)
     }
 
+
     buffers <- data.frame(matrix(NA, nrow = n_brow, ncol = ncol(design)))
     buffers <- setNames(buffers, names(design))
     buffers$row <- row
     buffers$col <- col
     buffers$treatments <- factor(treatments)
 
+    if(blocks) {
+        blocks_df <- 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) {
+            buffers[buffers$row <= blocks_df$row[i]&buffers$col <= blocks_df$col[i],"block"] <- blocks_df$block[i]
+        }
+    }
+
     design <- rbind(design, buffers)
 
     return(design)