From 4996023b0dbafb0595d5026825d0bd269a7f4e58 Mon Sep 17 00:00:00 2001 From: Wasin Pipattungsakul Date: Fri, 2 Oct 2026 17:45:59 +0930 Subject: [PATCH 1/4] perf(design_utils): swap treatments as integer codes - Precompute each group's plot rows once per level (`plots_by_group()`, returned by `swappable_groups()` as `group_plots`). - Swap factor codes and write the column back once, avoiding factor `==`/`[<-` label matching and data frame subsetting per iteration. - Fix single-index `sample()` when picking a different treatment, and stop padding `swapped_items` with "" for skipped swaps. Neighbour generation is 6-32x faster; end-to-end `speed()` ~1.25x, with identical results for the same seed. Co-Authored-By: Claude Opus 5.5 --- R/design_utils.R | 199 +++++++++++++------------- R/speed.R | 2 +- man/generate_multi_swap_neighbour.Rd | 2 +- man/generate_neighbour.Rd | 9 +- man/generate_single_swap_neighbour.Rd | 2 +- man/plots_by_group.Rd | 24 ++++ man/swappable_groups.Rd | 1 + tests/testthat/test-design_utils.R | 23 +++ 8 files changed, 154 insertions(+), 108 deletions(-) create mode 100644 man/plots_by_group.Rd diff --git a/R/design_utils.R b/R/design_utils.R index b41d14c..d409bde 100644 --- a/R/design_utils.R +++ b/R/design_utils.R @@ -12,9 +12,10 @@ #' @param linked_cols Character vector of column names moved in lockstep with #' the `swap` column, so that a value paired with a treatment stays paired with #' it. `NULL` (default) moves the `swap` column alone. -#' @param swappable Groups a swap can be proposed in, as returned in the -#' `swappable` element of [swappable_groups()]. `NULL` (default) considers -#' every group, which costs an iteration whenever an unswappable one is drawn. +#' @param group_plots Named list of the plot rows in each group a swap can be +#' proposed in, as returned in the `group_plots` element of +#' [swappable_groups()]. `NULL` (default) considers every group, which costs +#' an iteration whenever an unswappable one is drawn. #' #' @return A list with the updated design after swapping and information about #' swapped items @@ -28,16 +29,32 @@ generate_neighbour <- function(design, swap_all_blocks = getOption("speed.swap_all_blocks", FALSE), swap_all = FALSE, linked_cols = NULL, - swappable = NULL) { + group_plots = NULL) { if (swap_all) { return(generate_multi_swap_neighbour(design, swap, swap_within, swap_count, swap_all_blocks, linked_cols, - swappable)) + group_plots)) } else { return(generate_single_swap_neighbour(design, swap, swap_within, swap_count, swap_all_blocks, linked_cols, - swappable)) + group_plots)) } } +#' Plot Rows in Each Group +#' +#' @description +#' Rows with a treatment, split by group and fixed for a whole level. +#' +#' @inheritParams generate_neighbour +#' +#' @return A named list of row positions, one element per level of `swap_within`. +#' +#' @keywords internal +plots_by_group <- function(design, swap, swap_within) { + groups <- design[[swap_within]] + plots <- which(!is.na(groups) & !is.na(design[[swap]])) + return(split(plots, groups[plots])) +} + #' Exchange Linked Columns Between Two Sets of Plots #' #' @description @@ -81,17 +98,16 @@ exchange_linked <- function(design, linked_cols, plots_1, plots_2) { #' pair, because no two treatments there share a replication count. Kept #' separate from the rest of the unswappable groups because, unlike a group #' holding a single treatment, it is rarely what was intended. +#' - **group_plots** - the plot rows in each `swappable` group from [plots_by_group()]. #' #' @keywords internal swappable_groups <- function(design, swap, swap_within, swap_all) { - groups <- design[[swap_within]] - treatments <- as.character(design[[swap]]) - keep <- !is.na(groups) & !is.na(treatments) - # One pass over the design rather than a scan per group. Splitting on the # factor keeps every level, so a level the data no longer uses arrives empty # and falls out below rather than being dropped silently. - by_group <- split(treatments[keep], groups[keep]) + all_plots <- plots_by_group(design, swap, swap_within) + treatments <- as.character(design[[swap]]) + by_group <- lapply(all_plots, function(plots) return(treatments[plots])) counts <- lapply(by_group, function(x) return(as.integer(table(x)))) # Two distinct treatments are the minimum for any exchange, which also rules @@ -104,9 +120,11 @@ swappable_groups <- function(design, swap, swap_within, swap_all) { swap_all & !vapply(counts, function(x) return(any(duplicated(x))), logical(1)) + swappable <- exchangeable & !unequal return(list( - swappable = names(by_group)[exchangeable & !unequal], - unequal_replication = names(by_group)[unequal] + swappable = names(by_group)[swappable], + unequal_replication = names(by_group)[unequal], + group_plots = all_plots[swappable] )) } @@ -156,104 +174,82 @@ swappable_groups <- function(design, swap, swap_within, swap_all) { #' @keywords internal # fmt: skip generate_single_swap_neighbour <- function(design, swap, swap_within, swap_count, swap_all_blocks, - linked_cols = NULL, swappable = NULL) { - new_design <- design - + linked_cols = NULL, group_plots = NULL) { # Only groups a swap can be proposed in, so no iteration is spent on one that # cannot move. Settled once per level by `swappable_groups()`. - all_blocks <- design[[swap_within]] - blocks <- swappable %||% levels(all_blocks) - - if (swap_all_blocks) { - # Swap in all blocks - blocks_to_swap <- blocks - } else { - # Pick a random block - blocks_to_swap <- sample(blocks, 1) + group_plots <- group_plots %||% plots_by_group(design, swap, swap_within) + if (!swap_all_blocks) { + group_plots <- group_plots[sample.int(length(group_plots), 1)] } - swapped_idx <- 1 - swapped_items <- character(2 * swap_count * length(blocks_to_swap)) - - # Perform swaps in selected blocks - for (block in blocks_to_swap) { - # Get indices of plots in this block - block_indices <- which(all_blocks == block & !is.na(all_blocks) & !is.na(design[[swap]])) - - if (length(block_indices) >= 2) { - # Need at least 2 plots to swap - for (i in 1:swap_count) { - # Select two random plots in this block - swap_pair <- sample(block_indices, 2) - # `as.character()` because the swap column is a factor, whose values - # would otherwise reach `swapped_items` as their integer codes - to_be_swapped <- as.character(new_design[[swap]][swap_pair]) - - # If both plots have the same treatment, try to find a different one - if (to_be_swapped[1] == to_be_swapped[2]) { - different_indices <- block_indices[new_design[[swap]][block_indices] != to_be_swapped[1]] - - # Only proceed with swap if different treatments are available - if (length(different_indices) > 0) { - swap_pair[[2]] <- sample(different_indices, 1) - to_be_swapped[2] <- as.character(new_design[[swap]][[swap_pair[[2]]]]) - } else { - # Skip this swap - no different treatments available - to_be_swapped <- NULL - } - } + # Swapped as integer codes, sparing the label matching of factor `[<-` and `==` + items <- design[[swap]] + codes <- unclass(items) + swapped <- integer(2 * swap_count * length(group_plots)) + n_swapped <- 0L - # Perform the swap only if we have valid treatments to swap - if (!is.null(to_be_swapped)) { - new_design[[swap]][rev(swap_pair)] <- to_be_swapped - new_design <- exchange_linked(new_design, linked_cols, swap_pair[1], swap_pair[2]) - swapped_items[swapped_idx:(swapped_idx + 1)] <- to_be_swapped - swapped_idx <- swapped_idx + 2 + for (plots in group_plots) { + # Need at least 2 plots to swap + if (length(plots) < 2) { + next + } + + for (i in seq_len(swap_count)) { + pair <- plots[sample.int(length(plots), 2)] + code_1 <- codes[pair[1]] + code_2 <- codes[pair[2]] + + # If both plots have the same treatment, try to find a different one + if (code_1 == code_2) { + different <- plots[codes[plots] != code_1] + if (length(different) == 0) { + next } + + pair[2] <- different[sample.int(length(different), 1)] + code_2 <- codes[pair[2]] } + + codes[pair] <- c(code_2, code_1) + design <- exchange_linked(design, linked_cols, pair[1], pair[2]) + swapped[n_swapped + 1:2] <- c(code_1, code_2) + n_swapped <- n_swapped + 2L } } - return(list(design = new_design, swapped_items = swapped_items)) + attributes(codes) <- attributes(items) + design[[swap]] <- codes + + return(list(design = design, swapped_items = levels(items)[swapped[seq_len(n_swapped)]])) } #' Generate neighbour for sequential or hierarchical designs #' @keywords internal # fmt: skip generate_multi_swap_neighbour <- function(design, swap, swap_within, swap_count, swap_all_blocks, - linked_cols = NULL, swappable = NULL) { - new_design <- design - + linked_cols = NULL, group_plots = NULL) { # Settled once per level by `swappable_groups()` - groups <- swappable %||% levels(design[[swap_within]]) - - if (swap_all_blocks) { - # Swap in all groups - groups_to_swap <- groups - } else { - # Pick a random group - groups_to_swap <- sample(groups, 1) + group_plots <- group_plots %||% plots_by_group(design, swap, swap_within) + if (!swap_all_blocks) { + group_plots <- group_plots[sample.int(length(group_plots), 1)] } - swapped_idx <- 1 - swapped_items <- character(2 * swap_count * length(groups_to_swap)) + # Swapped as integer codes, sparing the label matching of factor `[<-` and `==` + items <- design[[swap]] + codes <- unclass(items) + swapped <- integer(2 * swap_count * length(group_plots)) + n_swapped <- 0L - # Perform swaps in selected groups - for (group in groups_to_swap) { - # Get unique treatments within this group - group_filter <- new_design[[swap_within]] == group & !is.na(new_design[[swap_within]]) - group_data <- new_design[group_filter & !is.na(new_design[[swap]]), ] - # `as.character()` so everything taken from it - `eligible`, `swap_pair`, - # and in turn `swapped_items` - is a treatment label rather than the integer - # code a factor contributes to a character vector - group_treatments <- as.character(unique(group_data[[swap]])) + for (plots in group_plots) { + group_codes <- codes[plots] + group_treatments <- unique(group_codes) # Counted once: every swap below exchanges equally replicated treatments, so # these counts are unaffected by them - group_counts <- tabulate(match(group_data[[swap]], group_treatments), length(group_treatments)) + group_counts <- tabulate(match(group_codes, group_treatments), length(group_treatments)) - if (nrow(group_data) >= 2) { - for (i in 1:swap_count) { + if (length(plots) >= 2) { + for (i in seq_len(swap_count)) { # Only proceed if there are at least 2 different treatments if (length(group_treatments) < 2) { # Skip this swap - only one treatment in this group @@ -283,27 +279,28 @@ generate_multi_swap_neighbour <- function(design, swap, swap_within, swap_count, eligible <- group_treatments[group_counts == as.integer(chosen)] } - # Select two different treatments - # Use sample with replace=FALSE to ensure they're different - swap_pair <- sample(eligible, 2, replace = FALSE) + # Two different treatments; `eligible` always holds at least two here + swap_pair <- eligible[sample.int(length(eligible), 2)] - # Find all plots with these treatments in this group - plots_1 <- which(group_filter & new_design[[swap]] == swap_pair[1]) - plots_2 <- which(group_filter & new_design[[swap]] == swap_pair[2]) + # Every plot of each treatment in this group + group_codes <- codes[plots] + plots_1 <- plots[group_codes == swap_pair[1]] + plots_2 <- plots[group_codes == swap_pair[2]] - # Swap all instances of these treatments - new_design[[swap]][plots_1] <- swap_pair[2] - new_design[[swap]][plots_2] <- swap_pair[1] - new_design <- exchange_linked(new_design, linked_cols, plots_1, plots_2) + codes[plots_1] <- swap_pair[2] + codes[plots_2] <- swap_pair[1] + design <- exchange_linked(design, linked_cols, plots_1, plots_2) - swapped_items[swapped_idx] <- swap_pair[1] - swapped_items[swapped_idx + 1] <- swap_pair[2] - swapped_idx <- swapped_idx + 2 + swapped[n_swapped + 1:2] <- swap_pair + n_swapped <- n_swapped + 2L } } } - return(list(design = new_design, swapped_items = swapped_items[1:(swapped_idx - 1)])) + attributes(codes) <- attributes(items) + design[[swap]] <- codes + + return(list(design = design, swapped_items = levels(items)[swapped[seq_len(n_swapped)]])) } #' Infer 'row' and 'col' with Patterns diff --git a/R/speed.R b/R/speed.R index 70c4590..a4f605b 100644 --- a/R/speed.R +++ b/R/speed.R @@ -423,7 +423,7 @@ speed_hierarchical <- function(data, optimise, quiet, seed, ...) { # Generate new design by swapping treatments at this level new_design <- generate_neighbour(current_design, opt$swap, opt$swap_within, current_swap_count, current_swap_all_blocks, opt$swap_all, opt$linked_cols, - groups$swappable) + groups$group_plots) # Calculate new score new_score_obj <- opt$obj_function(new_design$design,opt$swap, spatial_cols, adj_weight = adj_weight, diff --git a/man/generate_multi_swap_neighbour.Rd b/man/generate_multi_swap_neighbour.Rd index 5395d18..a00a3dc 100644 --- a/man/generate_multi_swap_neighbour.Rd +++ b/man/generate_multi_swap_neighbour.Rd @@ -11,7 +11,7 @@ generate_multi_swap_neighbour( swap_count, swap_all_blocks, linked_cols = NULL, - swappable = NULL + group_plots = NULL ) } \description{ diff --git a/man/generate_neighbour.Rd b/man/generate_neighbour.Rd index 28a1df6..c7d73b9 100644 --- a/man/generate_neighbour.Rd +++ b/man/generate_neighbour.Rd @@ -12,7 +12,7 @@ generate_neighbour( swap_all_blocks = getOption("speed.swap_all_blocks", FALSE), swap_all = FALSE, linked_cols = NULL, - swappable = NULL + group_plots = NULL ) } \arguments{ @@ -35,9 +35,10 @@ treatments, or named list for hierarchical designs} the \code{swap} column, so that a value paired with a treatment stays paired with it. \code{NULL} (default) moves the \code{swap} column alone.} -\item{swappable}{Groups a swap can be proposed in, as returned in the -\code{swappable} element of \code{\link[=swappable_groups]{swappable_groups()}}. \code{NULL} (default) considers -every group, which costs an iteration whenever an unswappable one is drawn.} +\item{group_plots}{Named list of the plot rows in each group a swap can be +proposed in, as returned in the \code{group_plots} element of +\code{\link[=swappable_groups]{swappable_groups()}}. \code{NULL} (default) considers every group, which costs +an iteration whenever an unswappable one is drawn.} } \value{ A list with the updated design after swapping and information about diff --git a/man/generate_single_swap_neighbour.Rd b/man/generate_single_swap_neighbour.Rd index 125e37d..cd0bae2 100644 --- a/man/generate_single_swap_neighbour.Rd +++ b/man/generate_single_swap_neighbour.Rd @@ -11,7 +11,7 @@ generate_single_swap_neighbour( swap_count, swap_all_blocks, linked_cols = NULL, - swappable = NULL + group_plots = NULL ) } \description{ diff --git a/man/plots_by_group.Rd b/man/plots_by_group.Rd new file mode 100644 index 0000000..235c9d3 --- /dev/null +++ b/man/plots_by_group.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/design_utils.R +\name{plots_by_group} +\alias{plots_by_group} +\title{Plot Rows in Each Group} +\usage{ +plots_by_group(design, swap, swap_within) +} +\arguments{ +\item{design}{Data frame containing the current design} + +\item{swap}{Column name of the treatment to swap, or named list for +hierarchical designs} + +\item{swap_within}{Column name defining groups within which to swap +treatments, or named list for hierarchical designs} +} +\value{ +A named list of row positions, one element per level of \code{swap_within}. +} +\description{ +Rows with a treatment, split by group and fixed for a whole level. +} +\keyword{internal} diff --git a/man/swappable_groups.Rd b/man/swappable_groups.Rd index 301490c..1ecf82d 100644 --- a/man/swappable_groups.Rd +++ b/man/swappable_groups.Rd @@ -26,6 +26,7 @@ A list with: pair, because no two treatments there share a replication count. Kept separate from the rest of the unswappable groups because, unlike a group holding a single treatment, it is rarely what was intended. +\item \strong{group_plots} - the plot rows in each \code{swappable} group from \code{\link[=plots_by_group]{plots_by_group()}}. } } \description{ diff --git a/tests/testthat/test-design_utils.R b/tests/testthat/test-design_utils.R index 70323e2..9d07876 100644 --- a/tests/testthat/test-design_utils.R +++ b/tests/testthat/test-design_utils.R @@ -144,6 +144,7 @@ test_that("swappable_groups separates unequal replication from other blockers", single <- swappable_groups(design, "treatment", "block", swap_all = FALSE) expect_equal(single$swappable, c("g1", "g2")) expect_length(single$unequal_replication, 0) + expect_identical(single$group_plots, list(g1 = 1:6, g2 = 7:12)) }) test_that("swappable_groups counts a level with no plots as unswappable", { @@ -158,6 +159,28 @@ test_that("swappable_groups counts a level with no plots as unswappable", { expect_length(result$unequal_replication, 0) }) +test_that("plots_by_group gives each group's rows, leaving out unswappable plots", { + design <- data.frame( + block = factor(c("b2", "b1", NA, "b2", "b1", "b1")), + treatment = factor(c("A", "B", "A", NA, "A", "C")) + ) + + expect_identical( + plots_by_group(design, "treatment", "block"), + list(b1 = c(2L, 5L, 6L), b2 = 1L) + ) +}) + +test_that("plots_by_group keeps a level with no plots as an empty group", { + design <- data.frame( + site = factor(c("a", "a", "b"), levels = c("a", "b", "c")), + treatment = factor(c("A", "B", "A")) + ) + + result <- plots_by_group(design, "treatment", "site") + expect_named(result, c("a", "b", "c")) + expect_identical(result$c, integer(0)) +}) test_that("speed() warns when a swap group is left frozen mid-search", { # A level 1 swap can leave a site with no two treatments sharing a replication # count. The search cannot move anything there, which should be reported rather From 301e8d4ba9f02cca3cd091a569aa1b34021522b2 Mon Sep 17 00:00:00 2001 From: Wasin Pipattungsakul Date: Fri, 2 Oct 2026 18:03:55 +0930 Subject: [PATCH 2/4] chore: clean up --- R/design_utils.R | 12 +++++------- R/speed.R | 2 +- man/generate_neighbour.Rd | 2 +- man/swappable_groups.Rd | 4 ++-- tests/testthat/test-design_utils.R | 7 +++---- 5 files changed, 12 insertions(+), 15 deletions(-) diff --git a/R/design_utils.R b/R/design_utils.R index d409bde..45b977f 100644 --- a/R/design_utils.R +++ b/R/design_utils.R @@ -13,7 +13,7 @@ #' the `swap` column, so that a value paired with a treatment stays paired with #' it. `NULL` (default) moves the `swap` column alone. #' @param group_plots Named list of the plot rows in each group a swap can be -#' proposed in, as returned in the `group_plots` element of +#' proposed in, as returned in the `swappable` element of #' [swappable_groups()]. `NULL` (default) considers every group, which costs #' an iteration whenever an unswappable one is drawn. #' @@ -93,12 +93,12 @@ exchange_linked <- function(design, linked_cols, plots_1, plots_2) { #' @inheritParams generate_neighbour #' #' @return A list with: -#' - **swappable** - groups holding an exchangeable pair. +#' - **swappable** - the plot rows from [plots_by_group()] of each group +#' holding an exchangeable pair. #' - **unequal_replication** - groups where `swap_all = TRUE` rules out every #' pair, because no two treatments there share a replication count. Kept #' separate from the rest of the unswappable groups because, unlike a group #' holding a single treatment, it is rarely what was intended. -#' - **group_plots** - the plot rows in each `swappable` group from [plots_by_group()]. #' #' @keywords internal swappable_groups <- function(design, swap, swap_within, swap_all) { @@ -120,11 +120,9 @@ swappable_groups <- function(design, swap, swap_within, swap_all) { swap_all & !vapply(counts, function(x) return(any(duplicated(x))), logical(1)) - swappable <- exchangeable & !unequal return(list( - swappable = names(by_group)[swappable], - unequal_replication = names(by_group)[unequal], - group_plots = all_plots[swappable] + swappable = all_plots[exchangeable & !unequal], + unequal_replication = names(by_group)[unequal] )) } diff --git a/R/speed.R b/R/speed.R index a4f605b..70c4590 100644 --- a/R/speed.R +++ b/R/speed.R @@ -423,7 +423,7 @@ speed_hierarchical <- function(data, optimise, quiet, seed, ...) { # Generate new design by swapping treatments at this level new_design <- generate_neighbour(current_design, opt$swap, opt$swap_within, current_swap_count, current_swap_all_blocks, opt$swap_all, opt$linked_cols, - groups$group_plots) + groups$swappable) # Calculate new score new_score_obj <- opt$obj_function(new_design$design,opt$swap, spatial_cols, adj_weight = adj_weight, diff --git a/man/generate_neighbour.Rd b/man/generate_neighbour.Rd index c7d73b9..657048e 100644 --- a/man/generate_neighbour.Rd +++ b/man/generate_neighbour.Rd @@ -36,7 +36,7 @@ the \code{swap} column, so that a value paired with a treatment stays paired wit it. \code{NULL} (default) moves the \code{swap} column alone.} \item{group_plots}{Named list of the plot rows in each group a swap can be -proposed in, as returned in the \code{group_plots} element of +proposed in, as returned in the \code{swappable} element of \code{\link[=swappable_groups]{swappable_groups()}}. \code{NULL} (default) considers every group, which costs an iteration whenever an unswappable one is drawn.} } diff --git a/man/swappable_groups.Rd b/man/swappable_groups.Rd index 1ecf82d..f656be9 100644 --- a/man/swappable_groups.Rd +++ b/man/swappable_groups.Rd @@ -21,12 +21,12 @@ treatments, or named list for hierarchical designs} \value{ A list with: \itemize{ -\item \strong{swappable} - groups holding an exchangeable pair. +\item \strong{swappable} - the plot rows from \code{\link[=plots_by_group]{plots_by_group()}} of each group +holding an exchangeable pair. \item \strong{unequal_replication} - groups where \code{swap_all = TRUE} rules out every pair, because no two treatments there share a replication count. Kept separate from the rest of the unswappable groups because, unlike a group holding a single treatment, it is rarely what was intended. -\item \strong{group_plots} - the plot rows in each \code{swappable} group from \code{\link[=plots_by_group]{plots_by_group()}}. } } \description{ diff --git a/tests/testthat/test-design_utils.R b/tests/testthat/test-design_utils.R index 9d07876..c90055d 100644 --- a/tests/testthat/test-design_utils.R +++ b/tests/testthat/test-design_utils.R @@ -136,15 +136,14 @@ test_that("swappable_groups separates unequal replication from other blockers", ) all_swap <- swappable_groups(design, "treatment", "block", swap_all = TRUE) - expect_equal(all_swap$swappable, "g2") + expect_named(all_swap$swappable, "g2") expect_equal(all_swap$unequal_replication, "g1") # Without `swap_all` a single pair of plots moves, so replication is irrelevant # and only the single-treatment group is stuck single <- swappable_groups(design, "treatment", "block", swap_all = FALSE) - expect_equal(single$swappable, c("g1", "g2")) + expect_identical(single$swappable, list(g1 = 1:6, g2 = 7:12)) expect_length(single$unequal_replication, 0) - expect_identical(single$group_plots, list(g1 = 1:6, g2 = 7:12)) }) test_that("swappable_groups counts a level with no plots as unswappable", { @@ -155,7 +154,7 @@ test_that("swappable_groups counts a level with no plots as unswappable", { ) result <- swappable_groups(design, "treatment", "site", swap_all = TRUE) - expect_equal(result$swappable, c("a", "b")) + expect_named(result$swappable, c("a", "b")) expect_length(result$unequal_replication, 0) }) From 7abe1bcea895e714f76a5807ccc5bf81d9293760 Mon Sep 17 00:00:00 2001 From: Wasin Pipattungsakul Date: Sat, 3 Oct 2026 21:40:08 +0930 Subject: [PATCH 3/4] chore: clean up --- R/design_utils.R | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/R/design_utils.R b/R/design_utils.R index 45b977f..c421f0b 100644 --- a/R/design_utils.R +++ b/R/design_utils.R @@ -12,10 +12,9 @@ #' @param linked_cols Character vector of column names moved in lockstep with #' the `swap` column, so that a value paired with a treatment stays paired with #' it. `NULL` (default) moves the `swap` column alone. -#' @param group_plots Named list of the plot rows in each group a swap can be -#' proposed in, as returned in the `swappable` element of -#' [swappable_groups()]. `NULL` (default) considers every group, which costs -#' an iteration whenever an unswappable one is drawn. +#' @param swappable Groups a swap can be proposed in, as returned in the +#' `swappable` element of [swappable_groups()]. `NULL` (default) considers +#' every group, which costs an iteration whenever an unswappable one is drawn. #' #' @return A list with the updated design after swapping and information about #' swapped items @@ -29,13 +28,13 @@ generate_neighbour <- function(design, swap_all_blocks = getOption("speed.swap_all_blocks", FALSE), swap_all = FALSE, linked_cols = NULL, - group_plots = NULL) { + swappable = NULL) { if (swap_all) { return(generate_multi_swap_neighbour(design, swap, swap_within, swap_count, swap_all_blocks, linked_cols, - group_plots)) + swappable)) } else { return(generate_single_swap_neighbour(design, swap, swap_within, swap_count, swap_all_blocks, linked_cols, - group_plots)) + swappable)) } } @@ -93,8 +92,7 @@ exchange_linked <- function(design, linked_cols, plots_1, plots_2) { #' @inheritParams generate_neighbour #' #' @return A list with: -#' - **swappable** - the plot rows from [plots_by_group()] of each group -#' holding an exchangeable pair. +#' - **swappable** - groups holding an exchangeable pair. #' - **unequal_replication** - groups where `swap_all = TRUE` rules out every #' pair, because no two treatments there share a replication count. Kept #' separate from the rest of the unswappable groups because, unlike a group @@ -172,21 +170,21 @@ swappable_groups <- function(design, swap, swap_within, swap_all) { #' @keywords internal # fmt: skip generate_single_swap_neighbour <- function(design, swap, swap_within, swap_count, swap_all_blocks, - linked_cols = NULL, group_plots = NULL) { + linked_cols = NULL, swappable = NULL) { # Only groups a swap can be proposed in, so no iteration is spent on one that # cannot move. Settled once per level by `swappable_groups()`. - group_plots <- group_plots %||% plots_by_group(design, swap, swap_within) + swappable <- swappable %||% plots_by_group(design, swap, swap_within) if (!swap_all_blocks) { - group_plots <- group_plots[sample.int(length(group_plots), 1)] + swappable <- swappable[sample.int(length(swappable), 1)] } # Swapped as integer codes, sparing the label matching of factor `[<-` and `==` items <- design[[swap]] codes <- unclass(items) - swapped <- integer(2 * swap_count * length(group_plots)) + swapped <- integer(2 * swap_count * length(swappable)) n_swapped <- 0L - for (plots in group_plots) { + for (plots in swappable) { # Need at least 2 plots to swap if (length(plots) < 2) { next @@ -225,20 +223,20 @@ generate_single_swap_neighbour <- function(design, swap, swap_within, swap_count #' @keywords internal # fmt: skip generate_multi_swap_neighbour <- function(design, swap, swap_within, swap_count, swap_all_blocks, - linked_cols = NULL, group_plots = NULL) { + linked_cols = NULL, swappable = NULL) { # Settled once per level by `swappable_groups()` - group_plots <- group_plots %||% plots_by_group(design, swap, swap_within) + swappable <- swappable %||% plots_by_group(design, swap, swap_within) if (!swap_all_blocks) { - group_plots <- group_plots[sample.int(length(group_plots), 1)] + swappable <- swappable[sample.int(length(swappable), 1)] } # Swapped as integer codes, sparing the label matching of factor `[<-` and `==` items <- design[[swap]] codes <- unclass(items) - swapped <- integer(2 * swap_count * length(group_plots)) + swapped <- integer(2 * swap_count * length(swappable)) n_swapped <- 0L - for (plots in group_plots) { + for (plots in swappable) { group_codes <- codes[plots] group_treatments <- unique(group_codes) From d1a5bd5f9d0823b1abaf90f54b69c5fe4263fb45 Mon Sep 17 00:00:00 2001 From: Wasin Pipattungsakul Date: Wed, 7 Oct 2026 09:51:30 +1030 Subject: [PATCH 4/4] chore: render doc --- man/generate_multi_swap_neighbour.Rd | 2 +- man/generate_neighbour.Rd | 9 ++++----- man/generate_single_swap_neighbour.Rd | 2 +- man/swappable_groups.Rd | 3 +-- 4 files changed, 7 insertions(+), 9 deletions(-) diff --git a/man/generate_multi_swap_neighbour.Rd b/man/generate_multi_swap_neighbour.Rd index a00a3dc..5395d18 100644 --- a/man/generate_multi_swap_neighbour.Rd +++ b/man/generate_multi_swap_neighbour.Rd @@ -11,7 +11,7 @@ generate_multi_swap_neighbour( swap_count, swap_all_blocks, linked_cols = NULL, - group_plots = NULL + swappable = NULL ) } \description{ diff --git a/man/generate_neighbour.Rd b/man/generate_neighbour.Rd index 657048e..28a1df6 100644 --- a/man/generate_neighbour.Rd +++ b/man/generate_neighbour.Rd @@ -12,7 +12,7 @@ generate_neighbour( swap_all_blocks = getOption("speed.swap_all_blocks", FALSE), swap_all = FALSE, linked_cols = NULL, - group_plots = NULL + swappable = NULL ) } \arguments{ @@ -35,10 +35,9 @@ treatments, or named list for hierarchical designs} the \code{swap} column, so that a value paired with a treatment stays paired with it. \code{NULL} (default) moves the \code{swap} column alone.} -\item{group_plots}{Named list of the plot rows in each group a swap can be -proposed in, as returned in the \code{swappable} element of -\code{\link[=swappable_groups]{swappable_groups()}}. \code{NULL} (default) considers every group, which costs -an iteration whenever an unswappable one is drawn.} +\item{swappable}{Groups a swap can be proposed in, as returned in the +\code{swappable} element of \code{\link[=swappable_groups]{swappable_groups()}}. \code{NULL} (default) considers +every group, which costs an iteration whenever an unswappable one is drawn.} } \value{ A list with the updated design after swapping and information about diff --git a/man/generate_single_swap_neighbour.Rd b/man/generate_single_swap_neighbour.Rd index cd0bae2..125e37d 100644 --- a/man/generate_single_swap_neighbour.Rd +++ b/man/generate_single_swap_neighbour.Rd @@ -11,7 +11,7 @@ generate_single_swap_neighbour( swap_count, swap_all_blocks, linked_cols = NULL, - group_plots = NULL + swappable = NULL ) } \description{ diff --git a/man/swappable_groups.Rd b/man/swappable_groups.Rd index f656be9..301490c 100644 --- a/man/swappable_groups.Rd +++ b/man/swappable_groups.Rd @@ -21,8 +21,7 @@ treatments, or named list for hierarchical designs} \value{ A list with: \itemize{ -\item \strong{swappable} - the plot rows from \code{\link[=plots_by_group]{plots_by_group()}} of each group -holding an exchangeable pair. +\item \strong{swappable} - groups holding an exchangeable pair. \item \strong{unequal_replication} - groups where \code{swap_all = TRUE} rules out every pair, because no two treatments there share a replication count. Kept separate from the rest of the unswappable groups because, unlike a group