Addition of probability in adsl

R/radsl.R

@@ -18,7 +18,8 @@
 #' @param study_duration (`numeric`)\cr Duration of study in years.
 #' @param with_trt02 (`logical`)\cr Should period 2 be added.
 #' @param ae_withdrawal_prob (`proportion`)\cr Probability that there is at least one
-#' Adverse Event leading to the withdrawal of a study drug.
+#'   Adverse Event leading to the withdrawal of a study drug.
+#' @param female_prob (`proportion`)\cr Probability of a subject being female, male is calculated by `1-female_prob`.
 #' @template param_cached
 #' @templateVar data adsl
 #'
@@ -51,6 +52,7 @@ radsl <- function(N = 400, # nolint
                     "BMRKR1" = c(seed = 1234, percentage = 0.1), "BMRKR2" = c(1234, 0.1), "BEP01FL" = NA
                   ),
                   ae_withdrawal_prob = 0.05,
+                  female_prob = 0.52,
                   cached = FALSE) {
   checkmate::assert_flag(cached)
   if (cached) {
@@ -63,6 +65,7 @@ radsl <- function(N = 400, # nolint
   checkmate::assert_number(study_duration, lower = 1)
   checkmate::assert_number(na_percentage, lower = 0, upper = 1)
   checkmate::assert_true(na_percentage < 1)
+  checkmate::assert_number(female_prob, lower = 0, upper = 1)
 
   if (!is.null(seed)) {
     set.seed(seed)
@@ -84,7 +87,7 @@ radsl <- function(N = 400, # nolint
     SUBJID = paste("id", seq_len(N), sep = "-"),
     AGE = sapply(stats::rchisq(N, df = 5, ncp = 10), max, 0) + 20,
     AGEU = "YEARS",
-    SEX = c("F", "M") %>% sample_fct(N, prob = c(.52, .48)),
+    SEX = c("F", "M") %>% sample_fct(N, prob = c(female_prob, 1 - female_prob)),
     ARMCD = c("ARM A", "ARM B", "ARM C") %>% sample_fct(N),
     RACE = c(
       "ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE", "AMERICAN INDIAN OR ALASKA NATIVE",

data-raw/git_diff_main.sh

@@ -10,14 +10,15 @@ set -e # Exit immediately if a command exits with a non-zero status.
 
 # --- Helper Function to Normalize Git URLs ---
 # This function reliably extracts the 'owner/repo' part from various URL formats.
+# This function reliably extracts the 'owner/repo' part from various URL formats.
 normalize_git_url() {
   local url=$1
   # Step 1: Remove an optional trailing slash
   local repo_path=${url%/}
   # Step 2: Remove the optional .git suffix
   repo_path=${repo_path%.git}
-  # Step 3: Remove everything up to the last colon or slash
-  repo_path=${repo_path##*[:/]}
+  # Step 3: Use a regular expression to extract the 'owner/repo' part
+  repo_path=$(echo "$repo_path" | sed -E 's|.*[:/]([^/]+/[^/]+)$|\1|')
 
   echo "$repo_path"
 }
@@ -39,6 +40,17 @@ ORIGIN_URL=$(git remote get-url origin 2>/dev/null || echo "") # Get origin URL
 NORM_UPSTREAM_URL=$(normalize_git_url "$UPSTREAM_URL")
 NORM_ORIGIN_URL=$(normalize_git_url "$ORIGIN_URL")
 
+# Show the normalized URLs for debugging
+if [[ -z "$NORM_ORIGIN_URL" ]]; then
+  echo "Warning: 'origin' remote not found or has no URL." >&2
+else
+  echo "Info: 'origin' remote URL found." >&2
+fi
+
+echo "Info: Normalized URLs (owner/repo):" >&2
+echo "Info:      ORIGIN_URL  -  $NORM_ORIGIN_URL" >&2
+echo "Info:    UPSTREAM_URL  -  $NORM_UPSTREAM_URL" >&2
+
 # Check if the normalized 'owner/repo' strings match
 if [[ -n "$NORM_ORIGIN_URL" && "$NORM_ORIGIN_URL" == "$NORM_UPSTREAM_URL" ]]; then
   # Scenario: Running in the main (non-forked) repository.

tests/testthat/test-radsl_alt_args.R

@@ -0,0 +1,9 @@
+test_that("radsl produces expected values with change of sex percentage", {
+  adsl <- radsl(100000, seed = 1)
+  female_prop <- sum(adsl$SEX == "F") / nrow(adsl)
+  expect_equal(female_prop, 0.52, tolerance = 1e-03)
+
+  adsl <- radsl(100000, seed = 1, female_prob = 0.8)
+  female_prop <- sum(adsl$SEX == "F") / nrow(adsl)
+  expect_equal(female_prop, 0.8, tolerance = 1e-03)
+})