randomize observations by groups (blocks)

问题:

I have a data frame with I obsevations, and each observation belongs to one of g categories.

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))

I want to randomly assign each observation to one of J "urns", given some vector of probabilities p. That is the probability of being assign to urn J=1 is p[1]. The added complexity is that I want to do this block by block.

If I ignore the blocks, I can do this easily:

J <- 3
p <- c(0.25, 0.5, 0.25)
df1 <- df %>% mutate(urn = sample(x = c(1:J), size = I, replace = T, prob = p))

I thought about this method to do it by "block"

# Block randomization
randomize_block <- function(g) {
  df1 <- df %>% filter(group==g) 
  size <- nrow(df1)
  df1 <- df1 %>% mutate(urn = sample(x = c(1:J), 
                                     size = size, 
                                     replace = T, 
                                     prob = p))
  return(df1)

}

df2 <- lapply(1:g, randomize_block)
df2 <- data.table::rbindlist(df2)

Is there a better way?

回答1:

Not sure if this is better, but here is a base R technique with data.frame df, that has group name "group" as well as urn assignments 1:J with assignment probabilities in vector p of length J.

# get urn assignment
urnAssignment  <- lapply(unique(df$group), 
                    function(i) sample(1:J, nrow(df[group==i,]), replace =T, prob=p))

# get a list that collects position of observations
obsOrder  <- lapply(unique(df$group), 
                    function(i) which(df$group == i))

df$urnAssignment <- unlist(urnAssignment)[unlist(obsOrder)]

回答2:

This does the trick using dplyr:

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

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