如何有效地按组对数据进行子采样?

时间:2013-06-04 07:33:03

标签: r

我确实遇到了this question中解释的类似问题。与该问题类似,我有一个包含3列(id,group,value)的数据框。我想从每个组中取出n个样本,并生成一个较小的数据帧,每个组有n个样本。

但是,我在模拟代码中执行了数百个子样本,而基于ddply的解决方案在我的代码中使用起来非常慢。我试图重写一个简单的代码,看看我是否可以获得更好的性能,但它仍然很慢(如果不是更糟,不比ddply解决方案更好)。以下是我的代码。我想知道它是否可以改进性能

#Producing example DataFrame
dfsize <- 10
groupsize <- 7
test.frame.1 <- data.frame(id = 1:dfsize, group = rep(1:groupsize,each = ceiling(dfsize/groupsize))[1:dfsize], junkdata = sample(1:10000, size =dfsize))


#Main function for subsampling
sample.from.group<- function(df, dfgroup, size, replace){
  outputsize <- 1
  newdf <-df # assuming a sample cannot be larger than the original
  uniquegroups <- unique(dfgroup)
  for (uniquegroup in uniquegroups){
    dataforgroup <- which(dfgroup==uniquegroup)
    mysubsample <- df[sample(dataforgroup, size, replace),]
    sizeofsample <- nrow(mysubsample)
    newdf[outputsize:(outputsize+sizeofsample-1), ] <- mysubsample
    outputsize <- outputsize + sizeofsample
  }
  return(newdf[1:(outputsize-1),])
}

#Using the function
sample.from.group(test.frame.1, test.frame.1$group, 100, replace = TRUE)

2 个答案:

答案 0 :(得分:3)

我认为这更清洁,可能更快:

z <- sapply(unique(test.frame.1$group), FUN= function(x){ 
            sample(which(test.frame.1$group==x), 100, TRUE)
            })
out <- test.frame.1[z,]
out

答案 1 :(得分:3)

这是两个基于plyr的解决方案:

library(plyr)

dfsize <- 1e4
groupsize <- 7
testdf <- data.frame(
  id = seq_len(dfsize),
  group = rep(1:groupsize, length = dfsize),
  junkdata = sample(1:10000, size = dfsize))

sample_by_group_1 <- function(df, dfgroup, size, replace) {
  ddply(df, dfgroup, function(x) {
    x[sample(nrow(df), size = size, replace = replace), , drop = FALSE]
  })
}

sample_by_group_2 <- function(df, dfgroup, size, replace) {
  idx <- split_indices(df[[dfgroup]])
  subs <- lapply(idx, sample, size = size, replace = replace)

  df[unlist(subs, use.names = FALSE), , drop = FALSE]
}

library(microbenchmark)
microbenchmark(
  ddply = sample_by_group_1(testdf, "group", 100, replace = TRUE),
  plyr = sample_by_group_2(testdf, "group", 100, replace = TRUE)
)

# Unit: microseconds
#   expr  min   lq median   uq   max neval
#  ddply 4488 4723   5059 5360 36606   100
#   plyr  443  487    507  536 31343   100

第二种方法要快得多,因为它只需一步即可完成子集化 - 如果你能在一步中弄清楚如何做到这一点,通常就是获得更好性能的简单方法。