Merge pull request #5 from aghaynes/main

docs, logo, single block size

NAMESPACE

@@ -1,3 +1,4 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(summary,randolist)
 export(blockrand)

R/blockrand.R

@@ -1,16 +1,39 @@
 #' Block randomization
 #'
-#' @param n total number of randomizations (within a single strata)
+#' Generate a randomization list for a single stratum with blocks of varying sizes.
+#'
+#' By default, frequency of the different block sizes is determined using Pascal's
+#' triangle.
+#' This has the advantage that small and large block sizes are less common than
+#' intermediate sized blocks, which helps with making it more difficult to guess
+#' future allocations, and reduces the risk of finishing in the middle of a large
+#' block.
+#'
+#' Unbalanced randomization is possible by specifying the same arm label multiple times.
+#'
+#' @param n total number of randomizations (within a single stratum)
 #' @param arms number of arms to randomise
-#' @param blocksizes vector of numbers of each arm to include in blocks
+#' @param blocksizes numbers of each arm to include in blocks
 #' @param pascal logical, whether to use pascal's triangle to determine block sizes
 #'
 #' @returns a data frame with columns block, blocksize, seq_in_block, arm
 #' @export
 #'
 #' @examples
+#' set.seed(1)
+#' blockrand(10)
+#'
+#' # different arm labels
+#' blockrand(10, arms = c("Arm 1", "Arm 2"))
+#'
+#' # block sizes 2, 4, and 6, 2 arms
+#' blockrand(20, blocksizes = 1:3)
+#'
+#' # unbalanced randomisation (2:1)
+#' blockrand(12, arms = c("Arm 1", "Arm 1", "Arm 2"))
 #'
-#' blockrand(100, blocksizes = c(1, 2))
+#' # fixed block sizes
+#' blockrand(10, blocksizes = 2)
 #'
 blockrand <- function(n,
                       arms = LETTERS[seq(2)],
@@ -20,20 +43,23 @@ blockrand <- function(n,
 
   N_per_block <- blocksizes * length(arms)
 
-  if(pascal) {
-    p <- pascalprops(length(N_per_block))
-  } else {
-    p <- rep(1 / length(N_per_block), length(N_per_block))
-  }
-
-  # estimate number of required blocks
-  min_blocks <- ceiling(n / min(N_per_block))
+  if(length(blocksizes) > 1){
+    if(pascal) {
+      p <- pascalprops(length(N_per_block))
+    } else {
+      p <- rep(1 / length(N_per_block), length(N_per_block))
+    }
+    # estimate number of required blocks
+    min_blocks <- ceiling(n / min(N_per_block))
 
-  # generate block sizes
-  blocks <- sample(N_per_block, min_blocks, replace = TRUE, prob = p)
+    # generate block sizes
+    blocks <- sample(N_per_block, min_blocks, replace = TRUE, prob = p)
 
-  # select blocks to reach n
-  blocks <- blocks[1:min(which(cumsum(blocks) >= n))]
+    # select blocks to reach n
+    blocks <- blocks[1:min(which(cumsum(blocks) >= n))]
+  } else {
+    blocks <- rep(N_per_block, ceiling(n / sum(N_per_block)))
+  }
 
   # generate randomization
   rlist <- lapply(seq_along(blocks), function(i){
@@ -46,7 +72,10 @@ blockrand <- function(n,
                arm = sample(arms_i, blocks[i]))
   }) |> do.call(what = rbind)
   rlist$seq_in_list <- seq_len(nrow(rlist))
-  rlist <- rlist[, c("seq_in_list", "block", "blocksize", "seq_in_block", "arm")]
+  rlist <- rlist[, c("seq_in_list", "block", "blocksize",
+                     "seq_in_block", "arm")]
+
+  class(rlist) <- c("randolist", class(rlist))
 
   return(rlist)
 }

R/summary.R

@@ -0,0 +1,19 @@
+#' @export
+summary.randolist <- function(object, ...){
+  cat("Randomisation list\n")
+  cat("Number of randomizations: ", nrow(object), "\n")
+  cat("Number of blocks: ", length(unique(object$block)), "\n")
+  cat("Block sizes:")
+  print(table(object$blocksize[object$seq_in_block == 1]))
+  cat("Arms: ")
+  print(table(object$arm))
+  invisible(object)
+}
+
+
+
+
+
+
+
+

README.Rmd

@@ -13,8 +13,7 @@ knitr::opts_chunk$set(
 )
 ```
 
-# `randolist`
-<!-- <img src='man/figures/logo.png' align="right" width="200"> -->
+# `randolist` <img src='man/figures/logo.png' align="right" width="200">
 
 <!-- badges: start -->
 
@@ -40,3 +39,33 @@ remotes::install_github("CTU-Bern/randolist")
 <!-- ``` r -->
 <!-- install.packages("randolist", repos = c('https://ctu-bern.r-universe.dev', 'https://cloud.r-project.org')) -->
 <!-- ``` -->
+
+## Generating randomization lists
+
+Load the package
+
+```{r}
+library(randolist)
+```
+
+
+### Unstratified randomization
+
+Where no strata are defined, the `blockrand` function can be used to create a randomization list. 
+
+```{r}
+blockrand(n = 10, 
+          blocksizes = 1:2)
+```
+
+The treatment label is set via the `arms` argument.
+
+Block sizes are defined via the `blocksizes` argument. The above example creates a randomization list with blocks of 1 or 2 *of each arm* (so in practice, the block sizes are 2 and 4).
+
+Allocation schemes beyond 1:1 randomization are possible by specifying the `arms` argument, specifically by using the same arm label multiple times.
+
+```{r}
+blockrand(n = 10, 
+          blocksizes = 1:2,
+          arms = c("A", "A", "B"))
+```

README.md

@@ -1,9 +1,8 @@
 
 <!-- README.md is generated from README.Rmd. Please edit that file -->
 
-# `randolist`
+# `randolist` <img src='man/figures/logo.png' align="right" width="200">
 
-<!-- <img src='man/figures/logo.png' align="right" width="200"> -->
 <!-- badges: start -->
 
 [![](https://img.shields.io/badge/dev%20version-0.0.1.9000-blue.svg)](https://github.com/CTU-Bern/randolist)
@@ -28,3 +27,66 @@ remotes::install_github("CTU-Bern/randolist")
 <!-- ``` r -->
 <!-- install.packages("randolist", repos = c('https://ctu-bern.r-universe.dev', 'https://cloud.r-project.org')) -->
 <!-- ``` -->
+
+## Generating randomization lists
+
+Load the package
+
+``` r
+library(randolist)
+```
+
+### Unstratified randomization
+
+Where no strata are defined, the `blockrand` function can be used to
+create a randomization list.
+
+``` r
+blockrand(n = 10, 
+          blocksizes = 1:2)
+#>    seq_in_list block blocksize seq_in_block arm
+#> 1            1     1         4            1   B
+#> 2            2     1         4            2   B
+#> 3            3     1         4            3   A
+#> 4            4     1         4            4   A
+#> 5            5     2         2            1   A
+#> 6            6     2         2            2   B
+#> 7            7     3         2            1   B
+#> 8            8     3         2            2   A
+#> 9            9     4         4            1   B
+#> 10          10     4         4            2   A
+#> 11          11     4         4            3   A
+#> 12          12     4         4            4   B
+```
+
+The treatment label is set via the `arms` argument.
+
+Block sizes are defined via the `blocksizes` argument. The above example
+creates a randomization list with blocks of 1 or 2 *of each arm* (so in
+practice, the block sizes are 2 and 4).
+
+Allocation schemes beyond 1:1 randomization are possible by specifying
+the `arms` argument, specifically by using the same arm label multiple
+times.
+
+``` r
+blockrand(n = 10, 
+          blocksizes = 1:2,
+          arms = c("A", "A", "B"))
+#>    seq_in_list block blocksize seq_in_block arm
+#> 1            1     1         3            1   A
+#> 2            2     1         3            2   B
+#> 3            3     1         3            3   A
+#> 4            4     2         6            1   A
+#> 5            5     2         6            2   A
+#> 6            6     2         6            3   A
+#> 7            7     2         6            4   B
+#> 8            8     2         6            5   A
+#> 9            9     2         6            6   B
+#> 10          10     3         6            1   A
+#> 11          11     3         6            2   B
+#> 12          12     3         6            3   A
+#> 13          13     3         6            4   A
+#> 14          14     3         6            5   A
+#> 15          15     3         6            6   B
+```

inst/logo.R

@@ -0,0 +1,27 @@
+library(ggplot2)
+library(scales)
+library(hexSticker)
+install.packages('rsvg')
+remotes::install_github('coolbutuseless/ggsvg')
+library(ggsvg)
+
+svg_txt <- readLines("inst/dice.svg")
+ap <- ggplot() +
+  geom_point_svg(data = data.frame(x = 1, y = 1),
+                 aes(x, y), svg = svg_txt, size = 25) +
+  theme_void() + theme_transparent()
+ap
+s <- sticker(ap, package="",
+             s_x=1, s_y=1, s_width=2, s_height=2,
+             filename="man/figures/logo.png",
+             h_fill = colorRampPalette(c("white", CTUtemplate::unibeRed()))(6)[3],
+             h_color = CTUtemplate::unibeRed(),
+             h_size = 2,
+             url = "randolist",
+             u_size = 12,
+             u_x = 1,
+             u_y = 0.15
+)
+s
+
+pkgdown::build_favicons(overwrite = TRUE)

pkgdown/favicon/site.webmanifest

@@ -0,0 +1,21 @@
+{
+  "name": "",
+  "short_name": "",
+  "icons": [
+    {
+      "src": "/web-app-manifest-192x192.png",
+      "sizes": "192x192",
+      "type": "image/png",
+      "purpose": "maskable"
+    },
+    {
+      "src": "/web-app-manifest-512x512.png",
+      "sizes": "512x512",
+      "type": "image/png",
+      "purpose": "maskable"
+    }
+  ],
+  "theme_color": "#ffffff",
+  "background_color": "#ffffff",
+  "display": "standalone"
+}

tests/testthat/test-blockrand.R

@@ -10,12 +10,19 @@ test_that("structure as expected", {
                c("seq_in_list", "block", "blocksize", "seq_in_block", "arm"))
 })
 
-test_that("seed produces consistent results", {
+test_that("seed produces consistent results (within session)", {
   set.seed(1)
   res3 <- blockrand(100, blocksizes = c(1, 2))
   expect_identical(res1, res3)
 })
 
+test_that("seed produces consistent results (across sessions/OSs)", {
+  expect_equal(res1$arm[1:10],
+               # sequence from AHs computer, 2025-02-17
+               c("A", "A", "B", "B", "A", "B", "A", "B", "B", "A"),
+               ignore_attr = TRUE)
+})
+
 test_that("number of randomizations is sufficient", {
   expect_true(nrow(res1) > 100)
 })
@@ -35,3 +42,9 @@ test_that("arm labels", {
   expect_true(all(res2$arm %in% c("Foo", "Bar")))
 })
 
+test_that("single block size works", {
+  tmp <- blockrand(100, blocksizes = 2)
+  expect_true(all(tmp$blocksize == 4))
+  expect_true(max(tmp$block) == 25)
+})
+