使用 R 每天将参与者随机分配到治疗中

Jak*_*arm 21 random r sampling

问题:

我试图使用 R 生成一个随机研究设计,其中一半的参与者被随机分配到“治疗 1”,另一半被分配到“治疗 2”。但是,因为一半的受试者是男性,一半是女性,而且我还想确保每次治疗都有相同数量的男性和女性,所以应该将一半的男性和女性分配到“治疗 1”,其余的一半应分配给“治疗 2”。

这种设计有两个并发症:(1)这是一项为期一年的研究,必须每天分配参与者进行治疗;(2) 每个参与者必须在 28 天内至少接受“治疗 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)
Run Code Online (Sandbox Code Playgroud)

...不幸的是,我不知道如何从这里开始。

理想结果:

我正在设想类似于这张表的结果: 我没有足够的声望点来嵌入图像,所以这里是链接,抱歉!

基本上每个参与者都有一列,每一天都有一行。与每一天相关的是分配到治疗 1 (T1) 或治疗 2 (T2),8 名男性中的 4 名和 8 名女性中的 4 名被分配到 T1,其余的分配到 T2。这些治疗每天重新分配,持续 1 年。此图表中未描述每位参与者在 28 天内至少需要接触 T1 10 次。如果其他东西更有意义,桌子不必看起来像那样!

All*_*ron 7

很好的第一个问题。感谢发布。

我对您的限制的理解是,在任何一天,四名男性必须接受一种治疗,四名男性必须接受另一种治疗。八位女性也是如此:每次治疗必须有四位。实际上,这意味着在任何一天,您只需要将随机样本应用于四个人,因为其余的人将有效地受到前四个人的约束。雄性 5 - 8 将与雄性 1 - 4 配对,因此雄性 1 总是与雄性 5 受到相反的待遇,雄性 2 与雄性 6 受到相反的待遇,依此类推。同样的模式应用于雌性,因此尽管个人分配是随机的,但在任何一天总是有 4 名女性接受治疗 1、4 名女性接受治疗 2、4 名男性接受治疗 1 和 4 名男性接受治疗 2。

您需要至少 10 天,每个人在 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)))
Run Code Online (Sandbox Code Playgroud)

现在df是一个数据框,其布局类似于您的表格。治疗以数字 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
Run Code Online (Sandbox Code Playgroud)


Par*_*ait 7

考虑拆分数据帧的一天和性别有by,然后用运行足够的样本,replicate在100次挑几个之一,理疗平衡:

数据

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

解决方案

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)
Run Code Online (Sandbox Code Playgroud)

输出

第一天

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
Run Code Online (Sandbox Code Playgroud)

第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
Run Code Online (Sandbox Code Playgroud)

理想情况下,出于分析目的,您应该以长格式保存数据(即整齐的数据)。但是如果需要宽格式,请考虑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
Run Code Online (Sandbox Code Playgroud)