如何监控应用功能的进度？

Question

我需要制定出一个2886*2886的相关性矩阵,问题是,建立一个中介的DataTable( RESULT)需要为它被绑定在一起很长一段时间,所以我想能够做以下事情,同时呼吁的最后一行RESULT=rbindlist(apply(COMB, 1, append))中代码如下:

1. 估计应用函数完成所需的时间
2. 监控其进度
3. 能够暂停并在以后继续

这是代码:

SOURCE=data.table(NAME=rep(paste0("NAME", as.character(1:2889)), each=600), VALUE=sample(c(TRUE,FALSE), 600, TRUE) )
> SOURCE
            NAME VALUE
      1:   NAME1  TRUE
      2:   NAME1  TRUE
      3:   NAME1  TRUE
      4:   NAME1  TRUE
      5:   NAME1  TRUE
     ---              
1733396: NAME999  TRUE
1733397: NAME999  TRUE
1733398: NAME999  TRUE
1733399: NAME999  TRUE
1733400: NAME999 FALSE

setkey(SOURCE,NAME)
a=SOURCE[,unique(NAME)]
COMB=data.table(expand.grid(a,a, stringsAsFactors=FALSE))
> COMB
             Var1    Var2
      1:    NAME1   NAME1
      2:   NAME10   NAME1
      3:  NAME100   NAME1
      4: NAME1000   NAME1
      5: NAME1001   NAME1
     ---                 
8346317:  NAME995 NAME999
8346318:  NAME996 NAME999
8346319:  NAME997 NAME999
8346320:  NAME998 NAME999
8346321:  NAME999 NAME999

append <- function(X) {
data.table(NAME1=X[1], VALUE1=SOURCE[X[1], VALUE], 
    NAME2=X[2], VALUE2=SOURCE[X[2], VALUE] )
}

RESULT=rbindlist(apply(COMB, 1, append))

任何的想法 ？

另外,有人知道是否有生成的数据表更快地RESULT从 SOURCE？RESULT是一个中间数据表VALUE1,VALUE2用于计算每对之间的相关值NAME.

有一个SOURCE RESULT像这样的子集:

SOURCE=SOURCE[sample(1:nrow(SOURCE), 3)]
setkey(SOURCE,NAME)
a=SOURCE[,unique(NAME)]
COMB=data.table(expand.grid(a,a, stringsAsFactors=FALSE))
RESULT=rbindlist(apply(COMB, 1, append))
> RESULT
      NAME1 VALUE1    NAME2 VALUE2
1: NAME1859   TRUE NAME1859   TRUE
2:  NAME768  FALSE NAME1859   TRUE
3:  NAME795   TRUE NAME1859   TRUE
4: NAME1859   TRUE  NAME768  FALSE
5:  NAME768  FALSE  NAME768  FALSE
6:  NAME795   TRUE  NAME768  FALSE
7: NAME1859   TRUE  NAME795   TRUE
8:  NAME768  FALSE  NAME795   TRUE
9:  NAME795   TRUE  NAME795   TRUE

后来我要做的RESULT[,VALUE3:=(VALUE1==VALUE2)]是最终得到相关值:RESULT[, mean(VALUE3), by=c("NAME1", "NAME2")] 所以也许整个过程可以更有效地完成,谁知道.

Answer 1

您可以使用库pbapply(git),它显示'*apply'系列中任何函数的时间估计和进度条.

如果你的问题:

library(pbapply)      

result <- rbindlist( pbapply(COMB, 1, append) )

PS.这个答案解决了你的两个初始点.关于第三点,我不确定是否可以暂停该功能.在任何情况下,您的操作确实需要太长时间,因此我建议您发布一个单独的问题,询问如何优化您的任务.

Answer 2

您可以使用 txtProgressBar

total <- 50
pb <- txtProgressBar(min = 0, max = total, style = 3)

lapply(1:total, function(i){
Sys.sleep(0.1)
setTxtProgressBar(pb, i)
})

或者utils从*ply包中使用家庭

library(plyr)
laply(1:100, function(i) {Sys.sleep(0.05); i}, .progress = "text")

查看plyr更多详细信息