適用機能の進行状況を監視する方法は？
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は、NAMEの各カップルの_VALUE1_と_VALUE2_の間の相関値を計算するための中間データテーブルです。
SOURCERESULTのサブセットを使用すると、次のようになります。
_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")]したがって、プロセス全体をより効率的に実行できる可能性があります。
ライブラリpbapply（ git ）を使用できます。このライブラリには、「* apply」ファミリの任意の関数の推定時間と進行状況バーが表示されます。
あなたの質問の場合：
library(pbapply)
result <- rbindlist( pbapply(COMB, 1, append) )
ps。この答えはあなたの2つの最初のポイントを解決します。 3点目については、一時停止できるかわかりません。いずれにせよ、実際には操作に時間がかかりすぎるため、タスクを最適化する方法を尋ねる別の質問を投稿することをお勧めします。
txtProgressBarパッケージからutilsを使用できます。
_total <- 50
pb <- txtProgressBar(min = 0, max = total, style = 3)
lapply(1:total, function(i){
Sys.sleep(0.1)
setTxtProgressBar(pb, i)
})
_または、plyrパッケージの_*ply_ファミリを使用します
_library(plyr)
laply(1:100, function(i) {Sys.sleep(0.05); i}, .progress = "text")
_詳細については、?create_progress_bar()を確認してください
代わりにこれを試してください：
setkey(SOURCE, NAME)
SOURCE[, CJ(NAME, NAME, unique = T)][
, mean(SOURCE[V1, VALUE] == SOURCE[V2, VALUE]), by = .(V1, V2)]
Fwiw、すべて大文字の名前はひどい選択ですimo-コードの書き込みと読み取りが非常に難しくなります。
相互結合を実行しようとしていますか？この例を参照してください。
#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)
ファンシープログレスバー（ベース/標準ライブラリにはない）には、 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
したがって、これは（3）ではなく、（1）と（2）の要件を満たします。中間結果をキャッシュするために、時々ディスクに何かを書き込むのがおそらく最も簡単です。高速シリアル化のためにあなたは試すことができます
これがお役に立てば幸いです。
テキストプログレスラインの独自の実装を作成しました。 txtProgressBar() について知らなかったので、@ JavKに感謝します！ただし、ここで実装を共有します。
この問題に取り組んでいる間、私は非常に役立つことを学びました。私はもともとカーソル制御のために terminfo に依存することを計画していました。具体的には、現在の端末のコードを事前に計算して、tputを使用してカーソルを左に移動します。
_tc_left <- system2('tput','cub1',stdout=T);
_そして、更新のたびに、そのコードを繰り返し印刷して、カーソルを進行状況行の先頭にリセットしました。このソリューションは機能しますが、適切なterminfoデータベースがインストールされているUnixターミナルでのみ機能します。他のプラットフォーム、特にWindows上のRStudioでは機能しません。
次に、txtProgressBar()コードを調べたところ（@JavKの回答を読んだ後）、カーソル位置をリセットするためにはるかに単純で堅牢なソリューションを使用していることがわかりました。キャリッジリターンを出力するだけです。 cat('\r');と同じくらい簡単です。これは、現在実装で使用しているものです。
これが私の解決策です。これには、progInit()と呼ばれる1つの初期化関数が含まれます。これは、計算量の多いループの前に1回呼び出す必要があり、ループの反復の総数を渡す必要があります（したがって、事前に知っておく必要があります）。ループカウンターをインクリメントして進行ラインを更新するprog()と呼ばれる1つの更新関数。状態変数は、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
_単純なアルゴリズムを使用して残り時間を見積もります。基本的に、合計経過時間をこれまでに完了した反復数で割って（時間/反復を取得するため）、それを残りの反復数で乗算します。
残念ながら、完全なCOMBオブジェクトでコードを実行すると、見積もりが不規則に動作します。最初は急速に低下し、次に着実に上昇します。これは、処理速度の低下が原因のようですが、説明できませんが、同じことがわかるかどうかはわかりません。いずれにせよ、理論的には、ループが完了に近づくのを待つと、推定残り時間の増加は逆転し、最終的には計算が完了すると推定はゼロになります。しかし、この癖にもかかわらず、コードが正しいと確信しています。これは、より高速な（つまり、計算量の少ない）テストケースで期待どおりに機能するためです。