每天使用 R 随机分配参与者进行治疗答案

【问题标题】：Use R to Randomly Assign of Participants to Treatments on a Daily Basis每天使用 R 随机分配参与者进行治疗
【发布时间】：2020-09-18 09:49:27
【问题描述】：

问题：

我正在尝试使用 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)

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

理想结果：

我设想的结果与此表近似：

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

【问题讨论】：

您能否更详细地说明如何将人们抽样到研究中？这在尝试建议代码时很重要。我不确定如何对不存在的人进行抽样。采样通常在您获得所有要采样的观察值后完成。如果您知道将招募多少男性和女性参与这项研究，就有可能找到解决方案。如果您不知道要抽样多少，我认为不可能解决您的问题 - 因为没有进行抽样的依据。
@Michelle 我想从描述和表格来看，OP 想招募 8 男 8 女，每人将连续 365 天接受治疗。这是没有根据的吗？
@Michelle 是的，Allan 的反应是完美的，参与者是由不同的机制预先确定的。实际上，我说的是对风力涡轮机进行采样，“男性”在设施的西部地区，“女性”在东部地区，但我试图简化请求以使其更通用，因此希望更多与更广泛的社区相关。
第一个问题很好。也许删除 for-loop 和 dplyr 标签，这将是完美的。 ??????
相关：cran.r-project.org/web/views/ExperimentalDesign.html

标签： r random sampling

【解决方案1】：

考虑使用 by 按 day 和 gender 拆分数据框，然后使用 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

【讨论】：

感谢@Parfait，很高兴看到解决同一问题的所有方法。我认为这个答案是最适合原帖的。保重！
很高兴听到。很高兴为您提供帮助！此外，此解决方案不会对任何数字进行硬编码，因此如果它们在几天内运行不均匀，则可以适应任何级别的观察。但是，无法均匀平衡的奇数分组将找不到匹配项。

【解决方案2】：

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

我对您的限制条件的理解是，在任何一天，四名男性必须接受一种治疗，而四名男性必须接受另一种治疗。八名女性也是如此：每次治疗必须有四名女性。实际上，这意味着在任何一天，您只需要将随机样本应用于四个人，因为其余个人将有效地受到前四个人的限制。男性 5 - 8 将与男性 1 - 4 配对，因此男性 1 总是得到与男性 5 相反的处理，男性 2 得到与男性 6 相反的处理，等等。同样的模式应用于女性，所以尽管个人分配是随机的，但在任何一天，总是有 4 名女性接受治疗 1、4 名女性接受治疗 2、4 名男性接受治疗 1 和 4 名男性接受治疗 2。

您希望每个人在 28 天内至少接受治疗 1 的 10 天。这进一步将随机化限制在确保每个 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 是一个数据框，其布局类似于您的表格。治疗以数字 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

【讨论】：

不错的答案！如果您像以前一样重申问题，那么解决方案就很简单了——T1 和 T2 中的每个参与者都需要 14 天。它比最初制定的要有趣得多。我相信正确的解决方案是零一线性规划问题，但我需要多考虑一下
哇，太快了！您的解决方案是简化和解决问题并满足要求的绝佳方式！我可能会分别为男性和女性生成four_cols和8个_cols，而不是两次绑定8个_cols，否则M1和F1在给定的一天总是在同一个组中（与M2和F2、M3和F3等相同）。亚历克斯，如果您有其他方法，也欢迎！非常感谢艾伦！！

【解决方案3】：

这是我的方法。当然可以优化，但我想分享一下我的想法：

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)

首先，我创建了一个为期 13 个周期、28 天的 data.frame。这给了我们 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

现在我构建一个函数，为每个组（男性/女性）创建一个逻辑向量，条件是“每个参与者至少 10 次 TRUE”

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。

【讨论】：

我认为“mutate(day = 1:nrow(.)”行的最后一段代码中缺少括号，它似乎需要“mutate(day = 1: nrow(.))”以避免出现错误消息。此外，由于某种原因，最后一行“select(-cycle)”导致以下错误“(function (classes, fdef, mtable) 中的错误：无法找到继承的签名'"tbl_df"'"的函数'select'的方法。我只加载了tidyverse包，没有其他包，所以不确定是什么产生了这个错误。我会继续排查问题！感谢您的回复！
做了两处更改（括号，强制使用dplyr 代替select）。请重试。
看看this question关于function (classes, fdef, mtable)错误。
@Einahpets 实际上我犯了一个错误，那个解决方案紫罗兰“男性和女性的一半应该分配给治疗 1，剩下的一半应该分配给治疗 2”条件。
@Einahpets 我对我的代码进行了更改。现在它包括了我以前错过的条件。