Question

我需要编制一个2886 * 2886相关矩阵，问题是构建一个中间数据表（RESULT）需要很长时间才能将它绑定在一起所以我希望能够做到以下几点在下面的代码中调用最后一行RESULT=rbindlist(apply(COMB, 1, append))时的事情：

估算应用功能完成所需的时间
监控其进度
能够暂停并在以后继续

以下是代码：

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），该图书会显示时间估算值和进度条，以显示＆＃39; * apply＆＃39;中的任何功能。家庭。

如果你的问题是：

library(pbapply)      

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

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

Answer 2

您可以使用txtProgressBar包中的utils：

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

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

或使用*ply包

中的plyr系列

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

查看?create_progress_bar()了解详情

Answer 3

请改为尝试：

setkey(SOURCE, NAME)

SOURCE[, CJ(NAME, NAME, unique = T)][
       , mean(SOURCE[V1, VALUE] == SOURCE[V2, VALUE]), by = .(V1, V2)]

Fwiw，全大写的名字是一个糟糕的选择imo - 使写作和阅读代码变得更加困难。

Answer 4

您是否尝试进行交叉加入？见这个例子：

#dummy data
set.seed(1)
SOURCE = data.frame(
  NAME = sample(paste0("Name", 1:4),20, replace = TRUE),
  VALUE = sample(c(TRUE,FALSE), 20, replace = TRUE)
)

#update colnames for join
d1 <- SOURCE
colnames(d1) <- c("NAME1", "VALUE1")
d2 <- SOURCE
colnames(d2) <- c("NAME2", "VALUE2")

#cross join
merge(d1, d2, all = TRUE)

Answer 5

我刚刚编写了自己的文本进度行实现。我不知道txtProgressBar()，所以感谢@JavK！但我仍然会在这里分享我的实现。

我在解决这个问题时学到了一些非常有用的东西。我原本打算依靠terminfo来控制光标。具体来说，我打算预先计算当前终端的代码，使用tput向左移动光标：

tc_left <- system2('tput','cub1',stdout=T);

然后我将重复打印该代码，以便在每次更新后将光标重置为进度行的开头。此解决方案有效，但仅限于安装了正确terminfo数据库的Unix终端;它不适用于其他平台，尤其是Windows上的RStudio。

然后，当我查看txtProgressBar()代码（阅读@JavK的答案之后）后，我发现他们使用更简单，更强大的解决方案来重置光标位置：它们只是打印一个回车！它就像cat('\r');一样简单，这就是我现在在实现中使用的。

这是我的解决方案。它涉及一个名为progInit()的初始化函数，您必须在计算密集型循环之前调用一次，并且必须传递循环的总迭代次数（因此您必须提前知道），并且需要一次更新名为prog()的函数，它递增循环计数器并更新进度行。状态变量只是以prog开头的名称转储到全局环境中。

progInit <- function(N,dec=3L) {
    progStart <<- Sys.time();
    progI <<- 1L;
    progN <<- N;
    progDec <<- dec;
}; ## end progInit()

prog <- function() {
    rem <- unclass(difftime(Sys.time(),progStart,units='secs'))*(progN/progI-1);
    days <- as.integer(rem/86400); rem <- rem-days*86400;
    hours <- as.integer(rem/3600); rem <- rem-hours*3600;
    minutes <- as.integer(rem/60); rem <- rem-minutes*60;
    seconds <- as.integer(rem); rem <- rem-seconds;
    millis <- as.integer(rem*1000);
    over <- paste(collapse='',rep(' ',20L));
    pct <- progI/progN*100;
    if (days!=0L) {
        msg <- sprintf(' %.*f%% %dd/%02d:%02d:%02d.%03d%s',
            progDec,pct,days,hours,minutes,seconds,millis,over);
    } else {
        msg <- sprintf(' %.*f%% %02d:%02d:%02d.%03d%s',
            progDec,pct,hours,minutes,seconds,millis,over);
    }; ## end if
    cat('\r');
    cat(msg);
    cat('\r');
    progI <<- progI+1L;
}; ## end prog()

library(data.table);
SOURCE <- data.table(NAME=rep(paste0("NAME", as.character(1:2889)), each=600), VALUE=sample(c(TRUE,FALSE), 600, TRUE) );
setkey(SOURCE,NAME);
a <- SOURCE[,unique(NAME)];
COMB <- data.table(expand.grid(a,a, stringsAsFactors=FALSE));
append <- function(X) {
    prog();
    data.table(NAME1=X[1],VALUE1=SOURCE[X[1],VALUE],NAME2=X[2],VALUE2=SOURCE[X[2],VALUE]);
}; ## end append()
##x <- COMB; progInit(nrow(x)); rbindlist(apply(x,1,append)); ## full object
x <- COMB[1:1e4,]; progInit(nrow(x)); rbindlist(apply(x,1,append)); ## ~30s

我使用一个简单的算法来估计剩余时间：我基本上将总经过时间除以到目前为止完成的迭代次数（获得时间/迭代），然后将其乘以剩余迭代次数。 / p>

不幸的是，当我在完整的COMB对象上运行代码时，估计行为不正常;首先它迅速下降，然后稳步上升。这似乎是由于处理速度的减慢造成的，我无法解释，而且我不确定你是否看到同样的事情。在任何情况下，理论上，如果您等待循环接近完成，估计剩余时间的增加应该反转，并且最终估计应该在计算完成时降至零。但是，尽管存在这种怪癖，我仍然非常有信心代码是正确的，因为它可以更快地（即计算密集度较低）测试用例工作。

Answer 6

对于精美的进度条（不在基础库/标准库中），还有progress：

pb <- progress_bar$new(
  format = "  downloading [:bar] :percent eta: :eta",
  total = 100, clear = FALSE, width= 60)
for (i in 1:100) {
  pb$tick()
  Sys.sleep(1 / 100)
}

#> downloading [========----------------------]  28% eta:  1s

因此，它满足要求（1）和（2），但不满足（3）。为了缓存中间结果，可能不时地将内容写入磁盘是最简单的。为了快速序列化，您可以尝试

fst：方便序列化列数据结构，例如data.tables
qs用于更常规的对象序列化

我希望这会有所帮助。

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

6 个答案: