关于 r：如何监控应用功能的进度？

How to monitor progress of an apply function?

我需要计算出一个 2886*2886 的相关矩阵，问题是构建中间数据表 (RESULT) 需要很长时间才能将其绑定在一起，所以我希望能够在执行以下操作的同时在下面的代码中调用最后一行 RESULT=rbindlist(apply(COMB, 1, append)) ：

估计应用功能完成所需的时间

监控其进度

能够暂停并在以后继续

这里是代码：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

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

有什么想法吗？

您还知道是否有更快的方法从 SOURCE 生成数据表 RESULT ？ RESULT 是一个中间数据表，用于计算每对 NAME 的 VALUE1 和 VALUE2 之间的相关值。

带有 SOURCE 的子集 RESULT看起来像这样：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

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”)]
所以也许整个过程可以更有效地完成，谁知道呢。

相关讨论

感谢您提供更好的方法，但是有没有办法监控它的进度？
@ChiseledAbs Id 只需插入一个打印语句(可能有一些频率)；例如对于上述：…, {print(paste(V1, V2)); mean(SOURCE[… )}, by = .(V1, V2)]
当我尝试您的代码时，我得到 Error in bmerge(i <- shallow(i), x, leftcols, rightcols, io <- haskey(i), : typeof x.VALUE (logical) != typeof i.V1 (character)
@ChiseledAbs 的答案有错别字 – 再试一次

对于花哨的进度条(不在基础/标准库中)，还有 progress:

1
2
3
4
5
6
7
8
9

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 用于更一般的对象序列化

我希望这会有所帮助。

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

我在解决这个问题时学到了一些非常有用的东西。我最初计划依靠 terminfo 进行光标控制。具体来说，我打算使用 tput:

预先计算当前终端的代码以向左移动光标

1	tc_left <- system2(‘tput’,’cub1′,stdout=T);

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

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

这是我的解决方案。它涉及一个名为 progInit() 的初始化函数，您必须在计算密集型循环之前调用一次，并且必须将循环的迭代总数传递给该函数(因此您必须提前知道)，以及一个名为prog() 增加循环计数器并更新进度线。状态变量以 prog.

开头的名称简单地转储到全局环境中

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

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(‘\
‘);
cat(msg);
cat(‘\
‘);
progI <<- progI+1L;
}; ## end prog()

1
2
3
4
5
6
7
8
9
10
11

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

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

不幸的是，当我在完整的 COMB 对象上运行代码时，估计的行为不正常；首先它迅速下降，然后稳步上升。这似乎是由于处理速度变慢造成的，我无法解释，我不确定你是否看到同样的事情。在任何情况下，理论上，如果您等待循环接近完成，估计剩余时间的增加应该会逆转，最终估计应该在计算完成时下降到零。但是尽管有这个怪癖，但我非常确信代码是正确的，因为它可以按预期运行更快(即计算量更少)的测试用例。

您是否要进行交叉连接？请参阅此示例：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

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

来源：https://www.codenong.com/37408668/

How to monitor progress of an apply function?

猜你喜欢