r - (有效)合并随机键控子集

Question

我有两个data.table；我想从那些与键匹配的元素中随机分配一个元素。我现在这样做的方式相当慢。

让我们具体点；这是一些示例数据:

dt1<-data.table(id=sample(letters[1:5],500,replace=T),var1=rnorm(500),key="id")
dt2<-data.table(id=c(rep("a",4),rep("b",8),rep("c",2),rep("d",5),rep("e",7)),
                place=paste(sample(c("Park","Pool","Rec Center","Library"),
                                   26,replace=T),
                            sample(26)),key="id")

我想为每次观察将两个随机选择的 place添加到 dt1中，但是 place必须在 id上匹配。

这是我现在正在做的事情:

get_place<-function(xx) sapply(xx,function(x) dt2[.(x),sample(place,1)])

dt1[,paste0("place",1:2):=list(get_place(id),get_place(id))]

这可以工作，但是速度很慢-在我的计算机上运行需要66秒，基本上是一个eon。

一个问题似乎是我似乎无法充分利用键控的优势:

像 dt2[.(dt1$id),mult="random"]这样的东西会很完美，但似乎不可能。

有什么建议么？

Answer 1

一个简单的答案

dt2[.(dt1),as.list(c(
  place=sample(place,size=2,replace=TRUE)
)),by=.EACHI,allow.cartesian=TRUE]

这种方法很简单，说明了笛卡尔联接和 data.table之类的 by=.EACHI功能，但速度很慢，因为对于 dt1的每一行，它(i)采样并(ii)将结果强制到列表中。

更快的答案

nsamp <- 2
dt3   <- dt2[.(unique(dt1$id)),list(i0=.I[1]-1L,.N),by=.EACHI]
dt1[.(dt3),paste0("place",1:nsamp):=
  replicate(nsamp,dt2$place[i0+sample(N,.N,replace=TRUE)],simplify=FALSE)
,by=.EACHI]

将 replicate与 simplify=FALSE结合使用(也可以在@bgoldst的答案中使用)最有意义:

它返回向量列表，这是在创建新列时data.table要求的格式。

replicate是用于重复仿真的标准R函数。

基准。 我们应该研究各种功能，而不要在进行过程中修改 dt1:

# candidate functions
frank2 <- function(){
  dt3   <- dt2[.(unique(dt1$id)),list(i0=.I[1]-1L,.N),by=.EACHI]
  dt1[.(dt3),
    replicate(nsamp,dt2$place[i0+sample(N,.N,replace=TRUE)],simplify=FALSE)
  ,by=.EACHI]
}
david2 <- function(){
  indx <- dt1[,.N, id]
  sim <- dt2[.(indx),
    replicate(2,sample(place,size=N,replace=TRUE),simplify=FALSE)
  ,by=.EACHI]
  dt1[, sim[,-1,with=FALSE]]
}
bgoldst<-function(){
  dt1[,
    replicate(2,ave(id,id,FUN=function(x) 
      sample(dt2$place[dt2$id==x[1]],length(x),replace=T)),simplify=F)
  ]
}

# simulation
size <- 1e6
nids <- 1e3
npls <- 2:15

dt1 <- data.table(id=sample(1:nids,size=size,replace=TRUE),var1=rnorm(size),key="id")
dt2 <- unique(dt1)[,list(place=sample(letters,sample(npls,1),replace=TRUE)),by=id]

# benchmarking
res <- microbenchmark(frank2(),david2(),bgoldst(),times=10)
print(res,order="cld",unit="relative")

这使

Unit: relative
      expr      min       lq     mean   median       uq      max neval cld
 bgoldst() 8.246783 8.280276 7.090995 7.142832 6.579406 5.692655    10   b
  frank2() 1.042862 1.107311 1.074722 1.152977 1.092632 0.931651    10  a 
  david2() 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    10  a 

如果我们切换参数...

# new simulation
size <- 1e4
nids <- 10
npls <- 1e6:2e6

dt1 <- data.table(id=sample(1:nids,size=size,replace=TRUE),var1=rnorm(size),key="id")
dt2 <- unique(dt1)[,list(place=sample(letters,sample(npls,1),replace=TRUE)),by=id]

# new benchmarking
res <- microbenchmark(frank2(),david2(),times=10)
print(res,order="cld",unit="relative")

我们看

Unit: relative
     expr    min     lq     mean   median       uq     max neval cld
 david2() 3.3008 3.2842 3.274905 3.286772 3.280362 3.10868    10   b
 frank2() 1.0000 1.0000 1.000000 1.000000 1.000000 1.00000    10  a 

正如人们可能期望的那样，哪种方式更快-折叠 dt1中的 david2或折叠 dt2中的 frank2-取决于折叠所压缩的信息量。