使用 R 每天随机分配参与者进行治疗
Use R to Randomly Assign of Participants to Treatments on a Daily Basis
问题：
我正在尝试使用 R 生成随机研究设计，其中一半参与者被随机分配到 "Treatement 1"，另一半被分配到 "Treatment 2"。然而，因为一半的受试者是男性，一半是女性，而且我还想确保相同数量的男性和女性接受每种治疗，所以男性和女性的一半应该分配给 "Treatment 1" 和剩下的一半应该分配给 "Treatment 2"。
这种设计有两个并发症：(1) 这是一项为期一年的研究，必须每天对参与者进行治疗分配； (2) 每个参与者必须在 28 天内至少接触 "Treatment 1" 10 次。
甚至可以在 R 界面中自动执行此操作吗？我假设是这样，但我认为我作为 R 程序员的初学者身份禁止我自己找到解决方案。几天来我一直在努力弄清楚如何实现这一点，并且浏览了该站点上许多无法在此处成功应用的听起来相似的帖子。我希望有人知道一些技巧可以帮助我解决这个问题，任何建议将不胜感激！
我尝试过的：
具体信息
# There are 16 participants
p <- c("P01", "P02", "P03", "P04", "P05", "P06", "P07", "P08", "P09", "P10", "P11", "P12", "P13", "P14", "P15", "P16")
# Half are male and half are female
g <- c(rep("M", 8), rep("F", 8))
# I make a dataframe but this may not be necessary
df <- cbind.data.frame(p,g)
# There are 365 days in one year
d <- seq(1,365,1)
...不幸的是，我不确定如何从这里开始。
理想结果：
我设想的结果类似于 table：
基本上每个参与者都有一列，每一天都有一行。与每一天相关联的是治疗 1 (T1) 或治疗 2 (T2) 的分配，8 名男性中的 4 名和 8 名女性中的 4 名被分配到 T1，其余分配到 T2。这些治疗每天都会重新分配，持续 1 年。此图表中未描述的是每个参与者需要在 28 天内至少接触 T1 10 次。如果其他东西更有意义，table 不必看起来像那样！
第一个问题很好。感谢发帖。
我对你的限制的理解是，在任何一天，四名男性必须接受一种治疗，四名男性必须接受另一种治疗。八名女性也是如此：必须有四名女性接受治疗。实际上，这意味着在任何给定的一天，您只需要将随机样本应用于四个人，因为其余的人将有效地受到前四个人的约束。雄性 5 - 8 将与雄性 1 - 4 配对，因此雄性 1 总是得到与雄性 5 相反的待遇，雄性 2 得到与雄性 6 相反的待遇，等等。相同的模式适用于雌性，因此尽管个人分配是随机的，但在任何一天总有 4 名女性接受治疗 1、4 名女性接受治疗 2、4 名男性接受治疗 1 和 4 名男性接受治疗 2。
你想要至少十天，每个人在 28 天内接受治疗 1。这进一步将随机化限制在确保每个 28 天的时间段包含总共 14 天的治疗 1 和 14 天的治疗 2 可能同样有意义的程度。
这样，您就可以获得这样的作业：
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)))
现在 df 是一个布局类似于 table 的数据框。治疗以数字 1 或 2 给出，参与者标记为 M1 - M8 和 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
这是我的方法。当然可以优化，但我想分享我的想法：
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)
首先，我创建了一个 data.frame，周期为 28 天，周期为 13 个。这给了我们 13*28=364 天。
days <- data.frame(day=rep(1:28, 13), cycle=rep(1:13, each=28))
df <- merge(df, days) # merge/cross_join with df
现在我构建一个函数，为每个组 (male/female) 创建一个逻辑向量，条件为 "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)
}
最后一步是将向量与给定的 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)
这会产生
# 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
1 和 0 对应于治疗 1 或 2。
考虑按 天 和 性别 和 by 拆分数据帧，然后 运行 足够的样本 replicate 在 100 次时选择其中一种治疗是平衡的：
数据
df <- merge(data.frame(participant = p, gender = g),
data.frame(days = seq(1,365)),
by=NULL)
解决方案
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)
输出
第 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
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
理想情况下，出于分析目的，您应该以长格式保存数据（即 tidy data）。但是，如果需要宽格式，请考虑 reshape 辅助和清理处理：
# 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
问题：
我正在尝试使用 R 生成随机研究设计，其中一半参与者被随机分配到 "Treatement 1"，另一半被分配到 "Treatment 2"。然而，因为一半的受试者是男性，一半是女性，而且我还想确保相同数量的男性和女性接受每种治疗，所以男性和女性的一半应该分配给 "Treatment 1" 和剩下的一半应该分配给 "Treatment 2"。
这种设计有两个并发症：(1) 这是一项为期一年的研究，必须每天对参与者进行治疗分配； (2) 每个参与者必须在 28 天内至少接触 "Treatment 1" 10 次。
甚至可以在 R 界面中自动执行此操作吗？我假设是这样，但我认为我作为 R 程序员的初学者身份禁止我自己找到解决方案。几天来我一直在努力弄清楚如何实现这一点，并且浏览了该站点上许多无法在此处成功应用的听起来相似的帖子。我希望有人知道一些技巧可以帮助我解决这个问题，任何建议将不胜感激！
我尝试过的：
具体信息
# There are 16 participants
p <- c("P01", "P02", "P03", "P04", "P05", "P06", "P07", "P08", "P09", "P10", "P11", "P12", "P13", "P14", "P15", "P16")
# Half are male and half are female
g <- c(rep("M", 8), rep("F", 8))
# I make a dataframe but this may not be necessary
df <- cbind.data.frame(p,g)
# There are 365 days in one year
d <- seq(1,365,1)
...不幸的是，我不确定如何从这里开始。
理想结果：
我设想的结果类似于 table：
基本上每个参与者都有一列，每一天都有一行。与每一天相关联的是治疗 1 (T1) 或治疗 2 (T2) 的分配，8 名男性中的 4 名和 8 名女性中的 4 名被分配到 T1，其余分配到 T2。这些治疗每天都会重新分配，持续 1 年。此图表中未描述的是每个参与者需要在 28 天内至少接触 T1 10 次。如果其他东西更有意义，table 不必看起来像那样！
第一个问题很好。感谢发帖。
我对你的限制的理解是，在任何一天，四名男性必须接受一种治疗，四名男性必须接受另一种治疗。八名女性也是如此：必须有四名女性接受治疗。实际上，这意味着在任何给定的一天，您只需要将随机样本应用于四个人，因为其余的人将有效地受到前四个人的约束。雄性 5 - 8 将与雄性 1 - 4 配对，因此雄性 1 总是得到与雄性 5 相反的待遇，雄性 2 得到与雄性 6 相反的待遇，等等。相同的模式适用于雌性，因此尽管个人分配是随机的，但在任何一天总有 4 名女性接受治疗 1、4 名女性接受治疗 2、4 名男性接受治疗 1 和 4 名男性接受治疗 2。
你想要至少十天，每个人在 28 天内接受治疗 1。这进一步将随机化限制在确保每个 28 天的时间段包含总共 14 天的治疗 1 和 14 天的治疗 2 可能同样有意义的程度。
这样，您就可以获得这样的作业：
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)))
现在 df 是一个布局类似于 table 的数据框。治疗以数字 1 或 2 给出，参与者标记为 M1 - M8 和 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
这是我的方法。当然可以优化，但我想分享我的想法：
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)
首先，我创建了一个 data.frame，周期为 28 天，周期为 13 个。这给了我们 13*28=364 天。
days <- data.frame(day=rep(1:28, 13), cycle=rep(1:13, each=28))
df <- merge(df, days) # merge/cross_join with df
现在我构建一个函数，为每个组 (male/female) 创建一个逻辑向量，条件为 "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)
}
最后一步是将向量与给定的 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)
这会产生
# 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
1 和 0 对应于治疗 1 或 2。
考虑按 天 和 性别 和 by 拆分数据帧，然后 运行 足够的样本 replicate 在 100 次时选择其中一种治疗是平衡的：
数据
df <- merge(data.frame(participant = p, gender = g),
data.frame(days = seq(1,365)),
by=NULL)
解决方案
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)
输出
第 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
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
理想情况下，出于分析目的，您应该以长格式保存数据（即 tidy data）。但是，如果需要宽格式，请考虑 reshape 辅助和清理处理：
# 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