Как контролировать ход применения функции?

Ответ 1

Вы можете использовать библиотеку pbapply (git), которая показывает оценку времени и индикатор выполнения для любой функции из семейства '* apply'.

В случае вашего вопроса:

library(pbapply)      

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

пс. Этот ответ решает ваши две начальные точки. Что касается третьего пункта, я не уверен, можно ли приостановить функцию. В любом случае ваша операция действительно занимает слишком много времени, поэтому я бы порекомендовал вам опубликовать отдельный вопрос с вопросом, как оптимизировать вашу задачу.

Ответ 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 family из пакета plyr

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

Проверьте ?create_progress_bar() для более подробной информации

Ответ 3

Попробуйте это вместо:

setkey(SOURCE, NAME)

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

Fwiw, имена all-caps - ужасный выбор imo - значительно затрудняет запись и чтение кода.

Ответ 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)

Ответ 5

Я просто написал свою собственную реализацию строки прогресса текста. Я не знал о txtProgressBar(), поэтому благодаря @JavK для этого! Но я по-прежнему буду использовать мою реализацию здесь.

Я изучил что-то очень полезное, работая над этой проблемой. Первоначально я планировал в зависимости от terminfo для управления курсором. В частности, я собирался прекомпилировать текущий код терминала, чтобы переместить курсор влево, используя tput:

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

И затем я собирался повторно распечатать этот код до reset курсора до начала строки выполнения после каждого обновления. Это решение работает, но только на терминалах Unix, на которых установлена ​​надлежащая база данных terminfo; он не будет работать на других платформах, в первую очередь RStudio в Windows.

Затем, когда я просмотрел код txtProgressBar() (после чтения ответа @JavK), я обнаружил, что они используют гораздо более простое и надежное решение для reset позиции курсора: они просто печатают возврат каретки! Это так же просто, как 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

Я использую простой алгоритм для оценки оставшегося времени: я в основном беру общее прошедшее время, деленное на количество выполненных до сих пор итераций (чтобы получить время/итерацию), а затем умножить это на количество оставшихся итераций.

К сожалению, когда я запускаю код на вашем полном COMB объекте, оценка ведет себя беспорядочно; сначала он быстро падает, затем он неуклонно растет. Это, по-видимому, вызвано замедлением скорости обработки, что я не могу объяснить, и я не уверен, что вы видите то же самое. В любом случае, теоретически, если вы дождитесь, когда цикл приблизится к завершению, увеличение оценочного оставшегося времени должно измениться, и в конечном итоге оценка должна упасть до нуля по мере завершения вычисления. Но, несмотря на эту причуду, я вполне уверен, что код правильный, поскольку он работает так, как ожидалось, для более быстрых (т.е. Менее интенсивных вычислительных) тестовых случаев.

Ответ 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 для более общей сериализации объекта

Надеюсь, это поможет.