Merge pull request #107 from ttscience/106-validate-minimization-randomization-with-unequal-allocation-ratios

kamilsi · web-flow · commit c8c7ea43c7a3 · 2025-10-02T16:23:44.000+02:00
Bugfix: unequal allocation
diff --git a/.github/workflows/document.yaml b/.github/workflows/document.yaml
@@ -20,13 +20,30 @@ jobs:
       - name: Setup R
         uses: r-lib/actions/setup-r@v2
         with:
+          r-version: '4.2.3'
           use-public-rspm: true
 
-      - name: Install dependencies
-        uses: r-lib/actions/setup-r-dependencies@v2
-        with:
-          extra-packages: any::roxygen2
-          needs: roxygen2
+      - name: Install system dependencies for systemfonts
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y --no-install-recommends \
+            pkg-config \
+            libfontconfig1-dev \
+            libfreetype6-dev \
+            libharfbuzz-dev \
+            libfribidi-dev
+
+      - uses: r-lib/actions/setup-renv@v2
+
+      - name: Install CI extras (roxygen2)
+        run: |
+          pkgs <- c("roxygen2")
+          for (p in pkgs) {
+            if (!requireNamespace(p, quietly = TRUE)) {
+              install.packages(p, repos = "https://packagemanager.posit.co/cran/latest")
+            }
+          }
+        shell: Rscript {0}
 
       - name: Document
         run: roxygen2::roxygenise()
diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml
@@ -18,12 +18,20 @@ jobs:
 
       - uses: r-lib/actions/setup-r@v2
         with:
+          r-version: '4.2.3'
           use-public-rspm: true
 
-      - uses: r-lib/actions/setup-r-dependencies@v2
-        with:
-          extra-packages: any::lintr, local::.
-          needs: lint
+      - uses: r-lib/actions/setup-renv@v2
+
+      - name: Install CI extras (lintr, cyclocomp)
+        run: |
+          pkgs <- c("lintr", "cyclocomp")
+          for (p in pkgs) {
+            if (!requireNamespace(p, quietly = TRUE)) {
+              install.packages(p, repos = "https://packagemanager.posit.co/cran/latest")
+            }
+          }
+        shell: Rscript {0}
 
       - name: Lint
         run: lintr::lint_package()
diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml
@@ -26,13 +26,21 @@ jobs:
 
       - uses: r-lib/actions/setup-r@v2
         with:
+          r-version: '4.2.3'
           use-public-rspm: true
           install-pandoc: true
 
-      - uses: r-lib/actions/setup-r-dependencies@v2
-        with:
-          extra-packages: any::pkgdown, local::.
-          needs: website
+      - uses: r-lib/actions/setup-renv@v2
+
+      - name: Install CI extras (pkgdown)
+        run: |
+          pkgs <- c("pkgdown")
+          for (p in pkgs) {
+            if (!requireNamespace(p, quietly = TRUE)) {
+              install.packages(p, repos = "https://packagemanager.posit.co/cran/latest")
+            }
+          }
+        shell: Rscript {0}
 
       - uses: r-lib/actions/setup-pandoc@v2
 
diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
@@ -39,12 +39,20 @@ jobs:
       
       - uses: r-lib/actions/setup-r@v2
         with:
+          r-version: '4.2.3'
           use-public-rspm: true
 
-      - uses: r-lib/actions/setup-r-dependencies@v2
-        with:
-          extra-packages: any::covr
-          needs: coverage
+      - uses: r-lib/actions/setup-renv@v2
+
+      - name: Install CI extras (covr)
+        run: |
+          pkgs <- c("covr")
+          for (p in pkgs) {
+            if (!requireNamespace(p, quietly = TRUE)) {
+              install.packages(p, repos = "https://packagemanager.posit.co/cran/latest")
+            }
+          }
+        shell: Rscript {0}
 
       - name: Install migrate
         run: |
@@ -73,7 +81,7 @@ jobs:
 
       - name: Upload test results
         if: failure()
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: coverage-test-failures
           path: ${{ runner.temp }}/package
diff --git a/.lintr b/.lintr
@@ -1,4 +1,2 @@
-linters: linters_with_defaults(
-  line_length_linter = line_length_linter(120),
-  object_usage_linter = NULL
-  )
+linters: lintr::linters_with_defaults(cyclocomp_linter = lintr::cyclocomp_linter(), line_length_linter = lintr::line_length_linter(120), return_linter = NULL, commas_linter = NULL, infix_spaces_linter = NULL, object_usage_linter = NULL)
+exclusions: list("vignettes/")
diff --git a/.vscode/settings.json b/.vscode/settings.json
@@ -1,5 +1,6 @@
 {
     "files.watcherExclude": {
         "**/renv/**": true
-    }
+    },
+    "r.lsp.promptToInstall": false
 }
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: unbiased
 Title: Unbiased: Production-Grade Randomization API
-Version: 1.0.1
+Version: 1.0.2
 Authors@R: c(
     person("Kamil", "Sijko", , "kamil.sijko@ttsi.com.pl",
            role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2203-1065")),
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,9 @@
+# unbiased 1.0.2
+
+## Bug Fixes
+
+- Fixed incorrect ratio allocation in minimisation randomization when unequal allocation ratios were provided. This was caused by a logic bug; updating a single line in `randomize-minimisation-pocock.R` restores expected allocation behavior.
+
 # unbiased 1.0.1
 
 ## Bug Fixes
diff --git a/R/randomize-minimisation-pocock.R b/R/randomize-minimisation-pocock.R
@@ -253,7 +253,7 @@ randomize_minimisation_pocock <-
         # compute scenario where each arm (x) gets new subject
         dplyr::mutate(dplyr::across(
           dplyr::where(is.numeric),
-          ~ dplyr::if_else(arm == x, .x + 1, .x) *
+          ~ dplyr::if_else(arm == x, .x + 1, .x) /
             ratio[arm]
         )) |>
         # compute dispersion across each covariate
diff --git a/inst/plumber/unbiased_api/plumber.R b/inst/plumber/unbiased_api/plumber.R
@@ -10,7 +10,7 @@
 #*   url = "https://ttscience.github.io/unbiased/")
 #* @apiLicense list(name = "MIT",
 #*   url = "https://github.com/ttscience/unbiased/LICENSE.md")
-#* @apiVersion 1.0.1
+#* @apiVersion 1.0.2
 #* @apiTag initialize Endpoints that initialize study with chosen
 #*   randomization method and parameters.
 #* @apiTag randomize Endpoints that randomize individual patients after the
diff --git a/tests/testthat/test-E2E-study-minimisation-pocock.R b/tests/testthat/test-E2E-study-minimisation-pocock.R
@@ -575,3 +575,55 @@ test_that("randomization works for 3 patients", {
   testthat::expect_equal(response_patient$status_code, 200)
   checkmate::expect_number(response_patient_body$patient_id, lower = 1)
 })
+
+test_that("API maintains ~3:1:1 ratio over 20 randomizations (p=1)", {
+  source("./test-helpers.R")
+  source("./audit-log-test-helpers.R")
+  with_db_fixtures("fixtures/example_db.yml")
+
+  # 1) Create study with ratio 1:1:3 and p=1
+  resp <- request(api_url) |>
+    req_url_path("study", "minimisation_pocock") |>
+    req_method("POST") |>
+    req_body_json(list(
+      identifier = "RATIO-113",
+      name = "Ratio 1:1:3",
+      method = "var",
+      p = 1,
+      arms = list("control" = 1, "active low" = 1, "active high" = 3),
+      covariates = list(
+        sex = list(weight = 1, levels = c("F","M")),
+        diabetes = list(weight = 1, levels = c("diabetes","no diabetes"))
+      )
+    )) |>
+    req_perform()
+  study <- resp |> resp_body_json() |> (\(b) b$study$id)()
+
+  # 2) Run ~20 randomizations via API with non-tie covariates
+  n <- 20
+  sex <- sample(c("F","M"), n, replace = TRUE, prob = c(0.55, 0.45))
+  diabetes <- sample(c("diabetes","no diabetes"), n, replace = TRUE, prob = c(0.2, 0.8))
+  assigned <- character(n)
+
+  for (i in seq_len(n)) {
+    current_state <- tibble::tibble(
+      sex = c(if (i > 1) sex[1:(i-1)] else character(0), sex[i]),
+      diabetes = c(if (i > 1) diabetes[1:(i-1)] else character(0), diabetes[i]),
+      arm = c(if (i > 1) assigned[1:(i-1)] else character(0), "")
+    )
+    r <- request(api_url) |>
+      req_url_path("study", study, "patient") |>
+      req_method("POST") |>
+      req_body_json(list(current_state = current_state)) |>
+      req_perform() |>
+      resp_body_json()
+    assigned[i] <- r$arm_name
+  }
+
+  # 3) Check ~3:1:1 via chi-square
+  arms <- c("control","active low","active high")
+  ratio <- c("control" = 1L, "active low" = 1L, "active high" = 3L)
+  obs <- table(factor(assigned, levels = arms))
+  x <- suppressWarnings(chisq.test(x = obs, p = ratio / sum(ratio), rescale.p = TRUE))
+  expect_gt(x$p.value, 0.01)
+})
diff --git a/tests/testthat/test-error-handling.R b/tests/testthat/test-error-handling.R
@@ -4,7 +4,7 @@ testthat::test_that("uses correct environment variables when setting up sentry",
       SENTRY_DSN = "https://sentry.io/123",
       GITHUB_SHA = "abc",
       SENTRY_ENVIRONMENT = "production",
-      SENTRY_RELEASE = "1.0.1"
+      SENTRY_RELEASE = "1.0.2"
     )
   )
 
@@ -18,7 +18,7 @@ testthat::test_that("uses correct environment variables when setting up sentry",
       testthat::expect_equal(app_name, "unbiased")
       testthat::expect_equal(app_version, "abc")
       testthat::expect_equal(environment, "production")
-      testthat::expect_equal(release, "1.0.1")
+      testthat::expect_equal(release, "1.0.2")
     },
     .package = "sentryR",
   )
diff --git a/tests/testthat/test-randomize-minimisation-pocock.R b/tests/testthat/test-randomize-minimisation-pocock.R
diff --git a/vignettes/articles/references.bib b/vignettes/articles/references.bib

Original file line number	Diff line number	Diff line change
`@@ -1,5 +1,6 @@`
`1`	`1`	`{`
`2`	`2`	`"files.watcherExclude": {`
`3`	`3`	`"/renv/": true`
`4`		`- }`
	`4`	`+ },`
	`5`	`+ "r.lsp.promptToInstall": false`
`5`	`6`	`}`