txtProgressBar paralel önyükleme için düzgün görüntülenmiyor

Question

Aşağıda, bir MWE sorunum var: Önyükleme kullanarak bazı işlevler için bir ilerleme çubuğu programladım (önyükleme paketinden önyükleme işleviyle).

Paralel işleme kullanmadığım sürece bu iyi çalışır (res_1core aşağıda). Paralel işlemeyi parallel = "multicore" ve olarak ayarlayarak kullanmak istiyorsam, ilerleme çubuğu düzgün görüntülenmiyor (res_2core aşağıda).

library(boot) 

rsq <- function(formula, data, R, parallel = c("no", "multicore", "snow"), ncpus = 1) { 
    env <- environment() 
    counter <- 0 
    progbar <- txtProgressBar(min = 0, max = R, style = 3) 
    bootfun <- function(formula, data, indices) { 
    d <- data[indices,] 
    fit <- lm(formula, data = d) 
    curVal <- get("counter", envir = env) 
    assign("counter", curVal + 1, envir = env) 
    setTxtProgressBar(get("progbar", envir = env), curVal + 1) 
    return(summary(fit)$r.square) 
    } 
    res <- boot(data = data, statistic = bootfun, R = R, formula = formula, parallel = parallel, ncpus = ncpus) 
    return(res) 
} 

res_1core <- rsq(mpg ~ wt + disp, data = mtcars, R = 1000) 
res_2core <- rsq(mpg ~ wt + disp, data = mtcars, R = 1000, parallel = "multicore", ncpus = 2) 

bu çizme fonksiyonu Çok işlem için tek çekirdekli işleme lapply ve mclapply çağrısı olmasından ile ilişkili olduğunu okumak. Bununla başa çıkmak için kolay bir çözüm bilen var mı? Yani, tüm paralel süreçleri dikkate alarak ilerlemeyi göstermek istiyorum.

Güncelleme Karolis Koncevičius girişine

teşekkürler, ben bir çözüm (aşağıda sadece kullanmak güncellenen rsq fonksiyonu) bulduk: Maalesef

rsq <- function(formula, data, R, parallel = c("no", "multicore", "snow"), ncpus = 1) { 
    bootfun <- function(formula, data, indices) { 
    d <- data[indices,] 
    fit <- lm(formula, data = d) 
    return(summary(fit)$r.square) 
    } 

    env <- environment() 
    counter <- 0 
    progbar <- txtProgressBar(min = 0, max = R, style = 3) 
    flush.console() 

    intfun <- function(formula, data, indices) { 
    curVal <- get("counter", envir = env) + ncpus 
    assign("counter", curVal, envir = env) 
    setTxtProgressBar(get("progbar", envir = env), curVal) 
    bootfun(formula, data, indices) 
    } 
    res <- boot(data = data, statistic = intfun, R = R, formula = formula, parallel = parallel, ncpus = ncpus) 
    return(res) 
} 

, çok çekirdekli işleme zaman için bu sadece çalışır Terminalden R'yi çalıştırıyorum. R konsolu ya da Rstudio'da bu şekilde nasıl ekleyeceğinize dair herhangi bir fikir var mı?

Answer 1

Tam olarak ne sipariş ettiğinizden değil, ancak yardımcı olabilir. yineleme her "adım" ilerleme gösterir -

progressReporter <- function(total, nBars=100, f, ...) { 
    count <- 1 
    step <- ceiling(total/nBars) 
    cat(paste(rep("|", nBars), collapse=""), "\r") 
    flush.console() 
    function(...) { 
     if (count %% step==0) { 
      cat(".") 
     } 
     count <<- count + 1 
     f(...) 
    } 
} 

Şimdi bu fonksiyon hile:

boot basit istatistik fonksiyonu

:

library(boot) 

bootfun <- function(formula, data, indices) { 
    d <- data[indices,] 
    fit <- lm(formula, data=d) 
    summary(fit)$r.square 
} 

Yüksek mertebeden fonksiyonu ilerlemesini görüntülemek için. 1000 yineleme varsa, iki çekirdek kullanın ve her 10. yinelemeyi yazdırın - bu işi yapar. Çekirdekler durumu paylaşmaz, ancak her biri sayacı 500'e kadar çalıştıracak ve işlev her iki sayaca da yanıt verecektir.

Diğer yandan, 1000 yineleme yaparsanız, 10 çekirdek çalıştırın ve her 200'ü bir raporlayın - tüm çekirdekler her biri 100'e eşit olacağından, işlev sessiz kalacaktır. Hiçbiri 200'e ulaşmayacak - ilerleme çubuğu yok. Umarım bu fikri alırsın. Bence çoğu vakada iyi olmalı.

Deneyin:

res_1core <- boot(formula="mpg ~ wt + disp", data=mtcars, R=1000, statistic=progressReporter(1000, nBars=100, f=bootfun)) 
res_2core <- boot(formula="mpg ~ wt + disp", data=mtcars, R=1000, statistic=progressReporter(1000, nBars=100, f=bootfun), parallel="multicore", ncpus=2)