按组（块）随机化观察而不进行替换答案

【问题标题】：randomize observations by groups (blocks) without replacement按组（块）随机化观察而不进行替换
【发布时间】：2016-04-21 18:29:45
【问题描述】：

这是follow up question。上一个问题中的答案是进行带放回的随机抽样。如何更改代码，以便将每个观察结果分配给 J“urn”，而不将观察结果放回“彩票”？

这是我现在的代码：

set.seed(9782)
I <- 500
g <- 10
library(dplyr)

anon_id <- function(n = 1, lenght = 12) {
  randomString <- c(1:n)
  for (i in 1:n)
  {
    randomString[i] <- paste(sample(c(0:9, letters, LETTERS),
                                    lenght, replace = TRUE),
                             collapse = "")
  }
  return(randomString)
}

df <- data.frame(id = anon_id(n = I, lenght = 16),
                 group = sample(1:g, I, T))

J <- 3
p <- c(0.25, 0.5, 0.25)

randomize <- function(data, urns=2, block_id = NULL, p=NULL, seed=9782) {
  if(is.null(p)) p <- rep(1/urns, urns) 
  if(is.null(block_id)){
    df1 <- data %>% 
      mutate(Treatment = sample(x = c(1:urns), 
                                size = n(), 
                                replace = T, 
                                prob = p))
    return(df1)
  }else{
    df1 <- data %>% group_by_(block_id) %>% 
      mutate(Treatment = sample(x = c(1:urns), 
                                size = n(), 
                                replace = T, 
                                prob = p))
  }
}    

df1 <- randomize(data = df, urns = J, block_id = "group", p = p, seed = 9782)

如果我将replace = T 更改为replace = F，我会收到以下错误：

错误：当 'replace = FALSE' 时，无法抽取大于总体的样本

澄清我的目标：

假设我有 10 个教室（或村庄，或类似的东西）。为简单起见，假设每个教室有 20 名学生（实际上他们会有 N_j）。每个教室的教室，我想将每个学生分配到 J 组之一，例如J=3。 P 表示将分配给每个组的分数。例如 25% 到第 1 组、40% 到第 2 组和 35% 到第 3 组。

【问题讨论】：

在最终通话中 groups = J = 3 但您创建了 df 和 g=10 组？
df %>% group_by(group) %>% mutate(sample_size = n()) 将向您显示您在 mutate 中每组要求的样本数
@eddi 我刚刚添加了一个说明。希望它能让我的目标明确。
sample(rep(seq_along(J), p*I)) 如果您的 p*I 不是整数值，则进行特殊处理。
假设我有 N = 20 个人，我希望他们拆分/分区/分配成大小为 p = c(.25,.5,.25) 的组。在这种情况下，我需要为第一组创建一个 0.25*20 = 5 个条目，第二组为 10，第三组为 5，例如 a0 = rep(seq_along(p), N*p)。现在，我将通过排列使这些分配随机化：a = sample(a0)

标签： r dplyr

【解决方案1】：

此解决方案基于@Frank 的评论。我创建了一个对块j 进行随机化的函数，以及另一个为每个块调用该函数的函数。

randomize_block <- function(data, block=NULL, block_name=NULL, urns, p, seed=9782) {
  set.seed(seed)
  if(!is.null(block)) {
    condition <- paste0(block_name,"==",block)
    df <- data %>% filter_(condition)
  } else df <- data
  if(is.null(p)) p <- rep(1/urns, urns) 
  N <- nrow(df)
  Np <- round(N*p,0)
  if(sum(Np)!=N) Np[1] <- N - sum(Np[2:length(Np)])
  Urns = rep(seq_along(p), Np)
  Urns = sample(Urns)
  df$urn <- Urns
  return(df)
}   

randomize <- function(data, block_name=NULL, urns, p, seed=9782) {
  if(is.null(p)) p <- rep(1/urns, urns)
  if(!is.null(block_name)){
    blocks <- unique(data[,block_name])
    df <- lapply(blocks, randomize_block, 
                 data = data, 
                 block_name=block_name, 
                 urns = urns, 
                 p = p, 
                 seed=seed)
    return(data.table::rbindlist(df))
  }else {
    df <- randomize_block(data = data,  
                          urns = urns, p = p, 
                          seed=seed)
  }
}

test <- randomize(data = df, block_name = "group", 
                  urns = 3, p = c(0.25, 0.5, 0.25), 
                  seed=4222016)

我正在尝试确定是否可以使用 dplyr 来执行此操作，非常欢迎使用替代解决方案！

【讨论】：

看起来不错。我可能会这样做 random_partition = function(p, N){Np <- round(N*p); Np[1L] <- N - sum(Np[-1L]); sample(rep(seq_along(p), Np))}; setDT(df)[, urn := random_partition(p, .N), by=group]

【解决方案2】：

My answer to your other question 没有替换，如下图：


block_rand <-  as.tibble(randomizr::block_ra(blocks = df$group, conditions = c("urn_1","urn_2","urn_3")))

df2 <- as.tibble(bind_cols(df, block_rand))

df2 %>% janitor::tabyl(group, value) 

df2 %>%
  group_by(id) %>% 
  filter(n()>1) %>%
  str()

【讨论】：