Use R to Randomly Assign of Participants to Treatments on a Daily Basis

Consider splitting data frame by day and gender with by, then run enough samples with replicate at 100 times to pick one of several where treatments are balanced:

Data

df <- merge(data.frame(participant = p, gender = g), 
            data.frame(days = seq(1,365)), 
            by=NULL)

Solution

df_list <- by(df, list(df$gender, df$days), function(sub){
  t <- replicate(100, {                                        # RUN 100 REPETITIONS OF EXPRESSION
    s <- sample(c("T1", "T2"), size=nrow(sub), replace=TRUE)   # SAMPLE "T1" AND "T2" BY SIZE OF SUBSET
    s[ sum(s == "T1") == sum(s == "T2") ]                      # FILTER TO EQUAL TREATMENTS 
  })

  t <- Filter(length, t)[[1]]             # SELECT FIRST OF SEVERAL NON-EMPTY RETURNS
  transform(sub, treatment = t)           # ASSIGN RESULT TO NEW COLUMN
})

# BIND DATA FRAMES AND RESET ROW.NAMES
final_df <- data.frame(do.call(rbind.data.frame, df_list), row.names=NULL)

Output

Day 1

head(final_df, 16)

#    participant gender days treatment
# 1          P09      F    1        T1
# 2          P10      F    1        T2
# 3          P11      F    1        T2
# 4          P12      F    1        T1
# 5          P13      F    1        T2
# 6          P14      F    1        T2
# 7          P15      F    1        T1
# 8          P16      F    1        T1
# 9          P01      M    1        T1
# 10         P02      M    1        T1
# 11         P03      M    1        T2
# 12         P04      M    1        T2
# 13         P05      M    1        T2
# 14         P06      M    1        T1
# 15         P07      M    1        T1
# 16         P08      M    1        T2

Day 365

tail(final_df, 16)

#      participant gender days treatment
# 5825         P09      F  365        T2
# 5826         P10      F  365        T2
# 5827         P11      F  365        T1
# 5828         P12      F  365        T2
# 5829         P13      F  365        T1
# 5830         P14      F  365        T2
# 5831         P15      F  365        T1
# 5832         P16      F  365        T1
# 5833         P01      M  365        T1
# 5834         P02      M  365        T2
# 5835         P03      M  365        T1
# 5836         P04      M  365        T2
# 5837         P05      M  365        T2
# 5838         P06      M  365        T2
# 5839         P07      M  365        T1
# 5840         P08      M  365        T1

Ideally, for analytical purposes you should keep data in long format (i.e., tidy data). But if needing wide format consider reshape with helper and cleanup processing:

# HELPER OBJECTS
final_df$participant_gender <- with(final_df, paste0(participant, gender))
new_names <- paste0(p, g)

# RESHAPE WIDE
wide_df <- reshape(final_df, v.names = "treatment", timevar = "participant_gender", 
                   idvar="days", drop = c("gender", "participant"), 
                   new.row.names = 1:365, direction = "wide")

# RENAME AND RE-ORDER COLUMNS
names(wide_df) <- gsub("treatment.", "", names(wide_df))
wide_df <- wide_df[c("days", new_names)]

head(wide_df)
#   days P01M P02M P03M P04M P05M P06M P07M P08M P09F P10F P11F P12F P13F P14F P15F P16F
# 1    1   T1   T1   T2   T2   T2   T1   T1   T2   T1   T2   T2   T1   T2   T2   T1   T1
# 2    2   T1   T1   T2   T1   T2   T1   T2   T2   T1   T2   T2   T1   T2   T2   T1   T1
# 3    3   T1   T1   T2   T1   T1   T2   T2   T2   T1   T2   T2   T2   T1   T2   T1   T1
# 4    4   T1   T1   T1   T2   T2   T2   T1   T2   T2   T1   T1   T2   T2   T1   T1   T2
# 5    5   T1   T1   T2   T1   T2   T2   T1   T2   T1   T1   T2   T1   T2   T2   T1   T2
# 6    6   T2   T1   T1   T1   T2   T2   T1   T2   T2   T2   T2   T1   T2   T1   T1   T1

Here is my approach. Surely it can be optimized, but I want to share my idea:

library(tidyverse)
p <- c("P01", "P02", "P03", "P04", "P05", "P06", "P07", "P08", "P09", "P10", "P11", "P12", "P13", "P14", "P15", "P16")

g <- c(rep("M", 8), rep("F", 8))

df <- data.frame(participant=p, sex=g)

First I create a data.frame for 13 cycles with 28 days. This gives us 13*28=364 days.

days <- data.frame(day=rep(1:28, 13), cycle=rep(1:13, each=28))
df <- merge(df, days)  # merge/cross_join with df

Now I build a function that creates a logical vector for each group (male/female) with the condition "at least 10 times TRUE per participant"

rand_assign <- function(n_participants=16){
  # create all possible combinations with 50 % treatment 1, 50 % treatment 2
  comb <- list(0:1) %>%
    rep(n_participants/2) %>%
    expand.grid() %>%
    filter(rowSums(.)==n_participants/4)

  save_list <- list()
  for (i in 1:2) {
    repeat {
      a <- comb %>% 
        nrow() %>%
        seq(1,.,1) %>%
        sample(28, replace=TRUE) %>%
        slice(comb,.)
      if (all(colSums(a) >= 10)) {
        break
      }
    }
    save_list[[i]] <- a
  }

  c <- save_list %>%
    cbind.data.frame() %>%
    t() %>%
    as.vector
  return(c)
}

Last step is combining the vector with the given data.frame

df %>%
  group_by(cycle) %>%
  mutate(treat_1 := rand_assign()) %>%
  group_by(sex) %>%
  pivot_wider(names_from=c(sex,participant), values_from=treat_1) %>%
  mutate(day = 1:nrow(.)) %>%
  dplyr::select(-cycle)

This yields

# A tibble: 364 x 17
     day M_P01 M_P02 M_P03 M_P04 M_P05 M_P06 M_P07 M_P08 F_P09 F_P10 F_P11 F_P12 F_P13
   <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
 1     1     1     1     0     1     0     1     0     0     0     0     1     1     1
 2     2     1     0     0     0     1     0     1     1     0     0     0     1     1
 3     3     0     1     0     1     0     1     1     0     0     1     0     1     0
 4     4     0     1     1     1     0     0     1     0     0     1     1     0     1
 5     5     0     1     1     0     1     0     0     1     1     0     0     1     1
 6     6     0     1     1     1     1     0     0     0     1     0     0     0     1
 7     7     0     0     0     1     1     1     0     1     0     0     1     0     0
 8     8     1     0     1     0     0     1     0     1     0     0     1     0     1
 9     9     0     1     0     1     1     0     1     0     1     0     1     1     0
10    10     1     1     0     0     1     1     0     0     1     1     0     0     0

with 1 and 0 corresponding to Treatment 1 or 2.


Nice first question. Thanks for posting.

My understanding of your constraints is that on any given day, four males must have one treatment and four males the other treatment. The same is true of the eight females: there must be four getting each treatment. Effectively, this means that on any given day, you only need a random sample applied to four individuals, since the rest of the individuals will effectively be constrained by the first four. Males 5 - 8 will be paired up to males 1 - 4, so that male 1 always get the opposite treatment to male 5, male 2 gets the opposite treatment to male 6, etc. The same pattern is applied to the females, so that although the individual assignations are random, there are always 4 females getting treatment 1, 4 females getting treatment 2, four males getting treatment 1 and four males getting treatment 2 on any given day.

You want at least ten days where each person gets treatment 1 in a 28-day period. This further constrains randomization to the point where it probably makes as much sense to ensure that each 28 day period contains a total of 14 days of treatment 1 and 14 days of treatment 2.

That way, you can get your assignations like this:

four_cols <- replicate(4, as.vector(replicate(14, sample(rep(1:2, 14))))[1:365])
eight_cols <- cbind(four_cols, 3 - four_cols)
sixteen_cols <- cbind(1:365, eight_cols, eight_cols)
df <- setNames(as.data.frame(sixteen_cols), c("Day", paste0("M", 1:8), paste0("F", 1:8)))

Now df is a data frame with a layout like your table. The treatments are given as numbers 1 or 2 and the participants are labelled M1 - M8 and F1 - F8:

df
#>    Day M1 M2 M3 M4 M5 M6 M7 M8 F1 F2 F3 F4 F5 F6 F7 F8
#> 1    1  1  1  1  1  2  2  2  2  1  1  1  1  2  2  2  2
#> 2    2  2  2  2  2  1  1  1  1  2  2  2  2  1  1  1  1
#> 3    3  2  1  1  2  1  2  2  1  2  1  1  2  1  2  2  1
#> 4    4  2  2  2  1  1  1  1  2  2  2  2  1  1  1  1  2
#> 5    5  1  2  1  1  2  1  2  2  1  2  1  1  2  1  2  2
#> 6    6  2  2  2  2  1  1  1  1  2  2  2  2  1  1  1  1
#> 7    7  1  2  1  1  2  1  2  2  1  2  1  1  2  1  2  2
#> 8    8  1  1  2  2  2  2  1  1  1  1  2  2  2  2  1  1
#> 9    9  2  2  1  2  1  1  2  1  2  2  1  2  1  1  2  1
#> 10  10  2  1  2  2  1  2  1  1  2  1  2  2  1  2  1  1
#> 11  11  1  2  2  2  2  1  1  1  1  2  2  2  2  1  1  1
#> 12  12  2  1  2  1  1  2  1  2  2  1  2  1  1  2  1  2
#> 13  13  1  1  1  1  2  2  2  2  1  1  1  1  2  2  2  2
#> 14  14  2  1  1  1  1  2  2  2  2  1  1  1  1  2  2  2
#> 15  15  1  1  2  1  2  2  1  2  1  1  2  1  2  2  1  2
#> 16  16  1  2  1  1  2  1  2  2  1  2  1  1  2  1  2  2
#> 17  17  2  2  2  2  1  1  1  1  2  2  2  2  1  1  1  1
#> ...
#> 365 365  2  2  2  2  1  1  1  1  2  2  2  2  1  1  1  1

Tags:

Random

R

Sampling