【问题标题】:(Efficiently) merge random keyed subset(有效)合并随机键控子集
【发布时间】:2015-11-06 09:24:49
【问题描述】:

我有两个data.tables;我想从匹配键的元素中随机分配一个元素给另一个元素。我现在这样做的方式很慢。

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

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

我想为每个观察添加两个随机选择的 places 到 dt1,但 places 必须匹配 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"] 这样的东西会很完美,但似乎不可能。

有什么建议吗?

【问题讨论】:

    标签: r data.table


    【解决方案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]
    

    replicatesimplify=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——取决于折叠压缩了多少信息。

    【讨论】:

    • 我正在使用allow.cartesian 进行沙盒处理,但从未真正使用过by=.EACHI,很好的例子!
    • 这里唯一缺少的可能是引用分配。
    • 谢谢 :) Fyi,这里的语法可能很好,但这可能不是很有效,因为(i)它没有像大卫的回答那样矢量化对 sample 的调用和(ii)强制列出......虽然我不知道如何解决这个问题。
    • 嗯.. 是的,我想知道size = 2 是否只是从这里的每个 i 采样两次(因此得名)。
    • @akrun 谢谢。我已经大修并清理了它。我的赢了,但无论如何我都会报告基准,就像我在这里所做的那样,尽管 Josh 是迄今为止最好的答案、投票和复选标记:stackoverflow.com/a/30171117/1191259
    【解决方案2】:

    用于此目的的完美函数是ave(),因为它允许为向量的每一组运行一个函数,并自动将返回值映射回该组的元素:

    set.seed(1);
    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' );
    dt1[,paste0('place',1:2):=replicate(2,ave(id,id,FUN=function(x) sample(dt2$place[dt2$id==x[1]],length(x),replace=T)),simplify=FALSE)]
    dt1;
    ##      id       var1        place1        place2
    ##   1:  a -0.4252677 Rec Center 23       Park 12
    ##   2:  a -0.3892372       Park 12    Library 22
    ##   3:  a  2.6491669       Park 14 Rec Center 23
    ##   4:  a -2.2891240 Rec Center 23       Park 14
    ##   5:  a -0.7012317    Library 22       Park 12
    ##  ---
    ## 496:  e -1.0624084    Library 16    Library 16
    ## 497:  e -0.9838209     Library 4    Library 26
    ## 498:  e  1.1948510    Library 26       Pool 21
    ## 499:  e -1.3353714       Pool 18    Library 26
    ## 500:  e  1.8017255       Park 20       Pool 21
    

    这应该适用于data.frames 以及data.tables。


    编辑:添加基准测试

    这个解决方案似乎是最快的,至少在进行了下面 Frank 建议的更正之后。

    frank<-function(){dt2[.(dt1),as.list(c(
      place=sample(place,size=2,replace=TRUE))),
      by=.EACHI,allow.cartesian=TRUE]}
    david<-function(){
      dt1[,paste0("place",1:2):=
            lapply(1:2,function(x) get_place(id,.N)),by=id]}
    bgoldst<-function(){dt1[,paste0("place",1:2):=
                              replicate(2,ave(id,id,FUN=function(x) 
                                sample(dt2$place[dt2$id==x[1]],length(x),replace=T)),
                                        simplify=F)]}
    
    microbenchmark(times=1000L,frank(),david(),bgoldst())
    
    Unit: milliseconds
          expr      min       lq     mean   median       uq      max neval cld
       frank() 5.125843 5.353918 6.276879 5.496042 5.772051 15.57155  1000  b 
       david() 6.049172 6.305768 7.172360 6.455687 6.669202 93.06398  1000   c
     bgoldst() 1.421330 1.521046 1.847821 1.570573 1.628424 89.60315  1000 a  
    

    【讨论】:

    • 您的基准测试不正确。您应该在更大的数据集上进行测试。而不是 500,尝试在 1e5 或更大上进行测试,然后看看哪个更快
    • 仅供参考,在我的基准测试中,我还查看了bgoldst() 的变体,用sample(dt2[.(x[1])]$place,length(x),replace=T) 代替了sample(dt2$place[dt2$id==x[1]],length(x),replace=T),发现它的速度大约是原来的15 倍。
    【解决方案3】:

    当您在每一行上运行sapply 时,您基本上没有在此处使用任何data.table 功能。或者,您可以使用二元连接和by 参数,每个id 只采样一次。您可以如下定义get_place

    get_place <- function(tempid, N) dt2[.(tempid), sample(place, N, replace = TRUE)]
    

    然后简单地做

    dt1[, place1 := get_place(id, .N), by = id]
    

    或者一个通用的解决方案是

    indx <- 1:2
    dt1[, paste0("place", indx) := lapply(indx, function(x) get_place(id, .N)), by = id]
    

    这是一个更大的基准dt1

    size = 1e6
    set.seed(123)
    dt1 <- data.table(id=sample(letters[1:5],size,replace=TRUE),var1=rnorm(size),key="id")
    

    使用与@bgoldst 答案中定义的相同功能

    microbenchmark(times = 10L, frank(), david(), bgoldst())
    # Unit: milliseconds
    # expr              min         lq       mean     median         uq        max neval
    # frank()   11627.68324 11771.4227 11887.1232 11804.6342 12012.4636 12238.1031    10
    # david()      84.62109   122.1117   121.1003   123.5861   128.0042   132.3591    10
    # bgoldst()   372.02267   400.8867   445.6231   421.3168   445.9076   709.5458    10
    

    这是同一想法的另一个更快的变体(如@Frank 的基准所示):

    indx<- dt1[,.N, id]
    sim <- dt2[.(indx),replicate(2,sample(place,size=N,replace=TRUE),simplify=FALSE),by=.EACHI]
    dt1[,paste0("place",1:2):=`[.listof`(sim,-1)]
    

    【讨论】:

    • 这是完美的。很简单;我想我需要更多的睡眠!
    • 只是好奇:这是否使用了我最近附加的答案的新版本?
    • @Frank,不,我直到现在才看到
    • @Frank 我真的很惊讶ave/replicate 组合如此高效,因为它们都是与split 组合的循环。我确定现在已经很晚了,我在这里遗漏了一些明显的东西。
    • 同样,replicate 应该比 lapply 更快,因为 replicate 是专门为该任务设计的,我猜。
    猜你喜欢
    • 2019-12-22
    • 2019-10-29
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2010-12-11
    • 2022-01-06
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多