Build a plate/batch design and export it as a PDF image and Excel spreadsheet

make_design.R

# # MIT License
#
# Copyright (c) 2024 Mickaël Canouil
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:

# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

make_design <- function(
  data, 
  formula, 
  batch_rows = 8, 
  batch_columns = 12, 
  seed = NULL, 
  basename = "design",
  complete = TRUE
) {
  set.seed(seed)
  samples_number <- nrow(data)
  batch_size <- batch_rows * batch_columns
  batch_number <- ceiling(samples_number / batch_size)
  full_columns_number <- (samples_number %/% batch_rows) %/% batch_number
  samples_left_number <- samples_number - full_columns_number * batch_number * batch_rows
  full_columns_blocks <- rep(batch_rows, full_columns_number * batch_number)
  
  if (complete) {
    if (samples_left_number %% batch_rows == 0) {
      full_columns_blocks <- c(full_columns_blocks, rep(batch_rows, samples_left_number %/% batch_rows))
    } else {
      stop(
        "The number of samples provided is not a multiple of ", batch_rows, ".\n",
        "Thus, a complete design is not possible."
      )
    }
    block_matrix <- full_columns_blocks
  } else {
    partial_columns_blocks <- rep(samples_left_number %/% batch_number, batch_number)
    last_samples_to_add <- rep(1, samples_left_number - sum(partial_columns_blocks))
    partial_columns_blocks[seq_along(last_samples_to_add)] <- 
      partial_columns_blocks[seq_along(last_samples_to_add)] + last_samples_to_add

    block_matrix <- unlist(
      as.data.frame(matrix(
        data = c(full_columns_blocks, partial_columns_blocks), 
        ncol = batch_number, 
        byrow = TRUE
      )), 
      use.names = FALSE
    )
  }
  
  block_design <- AlgDesign::optBlock(
    frml = formula,
    withinData = data[sample(1:nrow(data)), ],
    blocksizes = block_matrix, 
    nRepeats = 100
  )

  design <- data.table::rbindlist(lapply(
    X = names(block_design$Blocks),
    .data = block_design$Blocks,
    FUN = function(iblock, .data) {
      out <- .data[[iblock]]
      out[["Position"]] <- LETTERS[sample(1:nrow(out))]
      out
    }
  ))
  design[["Plate"]] <- unlist(mapply(
    FUN = rep, 
    x = sprintf("%02d", rep(1:batch_number, each = batch_columns))[seq_along(block_matrix)], 
    each = block_matrix, 
    USE.NAMES = FALSE, 
    SIMPLIFY = FALSE
  ))
  design[["Lane"]] <- unlist(mapply(
    FUN = rep, 
    x = sprintf("%02d", rep(1:batch_columns, times = batch_number))[seq_along(block_matrix)], 
    each = block_matrix, 
    USE.NAMES = FALSE, 
    SIMPLIFY = FALSE
  ))
  
  design <- design[order(design$Plate, design$Lane, design$Position), ]
  design[["IID"]] <- sprintf("S%03d", 1:nrow(design))

  writexl::write_xlsx(design, path = paste0(basename, ".xlsx"))
  
  invisible(design)
}

plot_design <- function(
  design,
  batch_rows = 8, 
  batch_columns = 12, 
  basename = "design",
  width = 29.7 - 5, 
  height = 21 - 5, 
  units = "cm"
) {
  batch_size <- batch_rows * batch_columns
  batch_number <- ceiling(nrow(design) / batch_size)
  
  p <- ggplot2::ggplot(
    data = merge(
      x = design,
      y = expand.grid(
        Plate = sprintf("%02d", 1:batch_number), 
        Lane = sprintf("%02d", 1:batch_columns), 
        Position = LETTERS[batch_rows:1]
      ),
      by = c("Plate", "Position", "Lane"),
      all.y = TRUE
    ), 
    mapping = ggplot2::aes(
      x = factor(Lane, levels = sprintf("%02d", 1:batch_columns)), 
      y = factor(Position, levels = LETTERS[batch_rows:1]), 
      fill = ifelse(is.na(cohort), as.character(NA), paste(cohort, sex, sep = " / ")), 
      label = id
    )
  ) +
    ggplot2::theme_light() +
    ggplot2::theme(panel.grid = ggplot2::element_blank(),  panel.border = ggplot2::element_blank()) +
    ggplot2::geom_tile(colour = "black", alpha = 0.5) +
    ggplot2::geom_text(angle = 0, size = 1.5, na.rm = TRUE) +
    ggplot2::scale_x_discrete(expand = c(0, 0), position = "top", drop = FALSE) +
    ggplot2::scale_y_discrete(expand = c(0, 0), drop = FALSE) +
    ggplot2::scale_fill_viridis_d() +
    ggplot2::labs(x = "Lane", y = "Position", fill = NULL) +
    ggplot2::facet_wrap(
      facets = ggplot2::vars(Plate), 
      scales = "free_x", 
      strip.position = "right", 
      nrow = batch_number
    )

  ggplot2::ggsave(
    filename = paste0(basename, ".pdf"), 
    plot = p, 
    width = width, 
    height = height, 
    units = units
  )
  
  invisible(p)
}