置换data.frame R中的组

时间:2014-08-01 17:24:54

标签: r permutation sample

我有一个像这样的data.frame:

DqStr <- "Group   q        Dq       SD.Dq
1 -3.0 0.7351 0.0067
1 -2.5 0.6995 0.0078
1 -2.0 0.6538 0.0093
2 -3.0 0.7203 0.0081
2 -2.5 0.6829 0.0094
2 -2.0 0.6350 0.0112"
Dq1 <- read.table(textConnection(DqStr), header=TRUE)

我想随机化组成员身份,但仅限于具有相同Dq1 $ q

值的行
g <-unique(Dq1$q)
Dq2<- data.frame()
for(n in g)
{
  Dqq <- Dq1[Dq1$q==n,]
  Dqq$Group <-sample(Dqq$Group)
  Dq2 <- rbind(Dq2,Dqq)    
}

也可以用plyr

完成
library(plyr)
ddply(Dq1,.(q), function(x) { x$Group <- sample(x$Group)
                              data.frame(x)})

因为我必须重复这几千次,我想知道是否有更好(更快)的方法。

2 个答案:

答案 0 :(得分:5)

如果我正确理解您的问题,这个data.table解决方案也会有效:

library(data.table)
Dq1 <- as.data.table(Dq1)
Dq1[, Group := sample(Group), by = q]

添加罗伯特的基准测试:

library(plyr)
library(data.table)

your_code <- function() { g <-unique(Dq1$q); Dq2<- data.frame(); for(n in g) { Dqq <- Dq1[Dq1$q==n,]; Dqq$Group <-sample(Dqq$Group); Dq2 <- rbind(Dq2,Dqq) } }
plyr_code <- function() { ddply(Dq1,.(q), function(x) { x$Group <- sample(x$Group); data.frame(x)}) }
base_code <- function() { Dq1$Group <- with(Dq1, ave(Group, q, FUN = sample)) }
data.table_code <- function() { Dq1 <- as.data.table(Dq1); Dq1[, Group := sample(Group), by = q] }

library(microbenchmark)
microbenchmark(your_code(), plyr_code(), base_code(), data.table_code())

结果:

    Unit: milliseconds
              expr      min       lq   median       uq      max neval
       your_code() 6.290822 6.771324 6.848123 6.966648 9.639748   100
       plyr_code() 3.124676 3.307456 3.356095 3.455422 4.564390   100
       base_code() 1.168874 1.301224 1.326055 1.348327 2.269652   100
 data.table_code() 1.124844 1.157866 1.180649 1.209577 1.419750   100

对于数据集这个小的data.table并不是很明显。但是如果你有很多行(并且如果你使用fread来读取数据作为data.table开始),你会看到plyr上的显着加速,以及基本R的一些加速。所以不要太认真对待这个基准。

根据Arun的评论,

修改已更改为使用as.data.table()而不是data.table()

答案 1 :(得分:3)

使用基数R,您可以使用ave

Dq1$Group <- with(Dq1, ave(Group, q, FUN = sample))

它有多快?

library(plyr); 

your_code <- function() { g <-unique(Dq1$q); Dq2<- data.frame(); for(n in g) { Dqq <- Dq1[Dq1$q==n,]; Dqq$Group <-sample(Dqq$Group); Dq2 <- rbind(Dq2,Dqq) } }
plyr_code <- function() { ddply(Dq1,.(q), function(x) { x$Group <- sample(x$Group); data.frame(x)}) }
base_code <- function() { Dq1$Group <- with(Dq1, ave(Group, q, FUN = sample)) }

library(microbenchmark)
microbenchmark(your_code(), plyr_code(), base_code())

结果:

 Unit: microseconds
         expr      min        lq    median        uq      max neval
  your_code()  745.592  855.3770  897.8580  956.0490 2981.026   100
  plyr_code() 2054.471 2186.2665 2259.6075 2530.7875 4771.403   100
  base_code()  216.323  239.0185  260.6925  282.8625  681.794   100