Ответ 1

Учитывая другие ответы, я подозреваю, что выполнить невозможно так, как вы это указали.

Однако я считаю, что есть способ приблизиться, если вы творчески используете пакет plyr. Хитрость заключается в использовании l_ply, который принимает список как входной и не создает выход.

Единственные реальные различия между этим решением и вашей спецификацией заключаются в том, что в цикле for вы можете напрямую изменять переменные в одной и той же среде. Используя l_ply, вам нужно отправить функцию, поэтому вам нужно быть более осторожным, если вы хотите изменить материал в родительской среде.

Попробуйте следующее:

library(plyr)
forp <- function(i, .fun){
  l_ply(i, .fun, .progress="tk")
}

a <- 0
forp(1:100, function(i){
  Sys.sleep(0.01)
  a<<-a+i
  })
print(a)
[1] 5050

Это создает индикатор выполнения и изменяет значение a в глобальной среде.

ИЗМЕНИТЬ.

Во избежание сомнений: аргумент .fun всегда будет функцией с единственным аргументом, например. .fun=function(i){...}.

Например:

for(i in 1:10){expr} эквивалентно forp(1:10, function(i){expr})

Другими словами:

• i - это параметр цикла цикла
• .fun - это функция с единственным аргументом i

Ответ 2

Мое решение очень похоже на Andrie, за исключением того, что использует базу R, и я запишу его комментарии о необходимости обернуть то, что вы хотите сделать в функции, и последующую необходимость использовать <<- для изменения материала в более высокой среде.

Здесь функция, которая ничего не делает и делает это медленно:

myfun <- function(x, text) {
  Sys.sleep(0.2)
  cat("running ",x, " with text of '", text, "'\n", sep="")
  x
}

Здесь моя функция forp. Обратите внимание, что независимо от того, что мы на самом деле зацикливаемся, вместо этого он вместо этого перебирает последовательность 1:n и получает правильный член того, что мы действительно хотим в цикле. plyr делает это автоматически.

library(tcltk)
forp <- function(x, FUN, ...) {
  n <- length(x)
  pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
  out <- vector("list", n)
  for (i in seq_len(n)) {
    out[[i]] <- FUN(x[i], ...)
    setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
  }
  close(pb)
  invisible(out)
}

И здесь, как можно использовать как for, так и forp, если все, что мы хотим сделать, это вызов myfun:

x <- LETTERS[1:5]
for(xi in x) myfun(xi, "hi")
forp(x, myfun, text="hi")

И вот как они могут быть использованы, если мы хотим что-то изменить на этом пути.

out <- "result:"
for(xi in x) {
  out <- paste(out, myfun(xi, "hi"))
}

out <- "result:"
forp(x, function(xi) {
    out <<- paste(out, myfun(xi, "hi"))
})

Для обеих версий результат

> out
[1] "result: A B C D E"

EDIT: после просмотра вашего решения (daroczig) у меня есть другая идея, которая может быть не такой уж громоздкой, а именно для оценки выражения в родительском фрейме. Это облегчает учет значений, отличных от i (теперь заданных с аргументом index), хотя по состоянию на данный момент я не думаю, что он обрабатывает функцию как выражение, но просто для нее вместо a который не имеет значения.

forp2 <- function(index, x, expr) {
  expr <- substitute(expr)
  n <- length(x)
  pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
  for (i in seq_len(n)) {
    assign(index, x[i], envir=parent.frame())
    eval(expr, envir=parent.frame())
    setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
  }
  close(pb)
}

Код для запуска моего примера сверху будет

out <- "result:"
forp2("xi", LETTERS[1:5], {
    out <- paste(out, myfun(xi, "hi"))
})

и результат тот же.

ДРУГОЙ РЕДАКТИРОВАНИЕ, основанный на дополнительной информации в своем предложении:

Синтаксис forX(1:1000) %doX$ { expression } возможен; что делает пакет foreach. Я слишком ленив сейчас, чтобы построить его из вашего решения, но, построив мое, он может выглядеть так:

`%doX%` <- function(index, expr) {
  x <- index[[1]]
  index <- names(index)
  expr <- substitute(expr)
  n <- length(x)
  pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
  for (i in seq_len(n)) {
    assign(index, x[i], envir=parent.frame())
    eval(expr, envir=parent.frame())
    setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
  }
  close(pb)
  invisible(out)
}

forX <- function(...) {
  a <- list(...)
  if(length(a)!=1) {
    stop("index must have only one element")
  }
  a
}

Тогда синтаксис использования таков, и результат будет таким же, как и выше.

out <- "result:"
forX(xi=LETTERS[1:5]) %doX% {
  out <- paste(out, myfun(xi, "hi"))
}
out

Ответ 3

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

R.utils также содержит встроенные в него строки выполнения, а инструкции для их использования в циклах цикла.

Ответ 4

На что вы надеетесь, я думаю, что это будет выглядеть как

body(for)<- as.call(c(as.name('{'),expression([your_updatebar], body(for))))

И да, проблема в том, что "for" не является функцией или, по крайней мере, не тем, чье "тело" доступно. Вы могли бы, я полагаю, создать функцию "forp", которая принимает в качестве аргументов 1) строку, которая должна быть преобразована в счетчик циклов, например, " ( i in seq(1,101,5) )" и 2) тело вашего предполагаемого цикла, например y[i]<- foo[i]^2 ; points(foo[i],y[i], а затем перепрыгните через магию getcallparse, чтобы выполнить фактический цикл. Затем, в псевдокоде (не близко к фактическому R-коду, но я думаю, вы видите, что должно произойти)

forp<-function(indexer,loopbody) { 

pseudoparse( c("for (", indexer, ") {" ,loopbody,"}") }

Ответ 5

Проблема в том, что for-loop в R обрабатывается специальным. Нормальная функция не может выглядеть так. Некоторые небольшие настройки могут заставить его зацикнуться довольно близко. И, как отметил @Aaron, парадигма foreach package %dopar% кажется наиболее подходящей. Вот моя версия, как это могло бы работать:

`%doprogress%` <- function(forExpr, bodyExpr) {
   forExpr <- substitute(forExpr)
   bodyExpr <- substitute(bodyExpr)

   idxName <- names(forExpr)[[2]]
   vals <- eval(forExpr[[2]])

   e <- new.env(parent=parent.frame())

   pb <- tkProgressBar(title = "Working hard:", min = 0, max = length(vals), width = 300)
   for (i in seq_along(vals)) {
     e[[idxName]] <- vals[[i]]
     eval(bodyExpr, e)
     setTkProgressBar(pb, i, label=paste( round(i/length(vals)*100, 0), "% ready!"))
   }
}


# Example usage:

foreach(x = runif(10)) %doprogress% { 
  # do something
  if (x < 0.5) cat("small\n") else cat("big")
}

Как вы можете видеть, вам нужно набрать x = 1:10 вместо x in 1:10, а инфиксный оператор %<whatever>% необходим, чтобы получить конструкцию цикла и тело цикла. В настоящее время я не выполняю проверку ошибок (чтобы избежать путаницы с кодом). Вы должны проверить имя функции ("foreach"), количество аргументов в ней (1) и фактически получить действительную переменную цикла ("x"), а не пустую строку.

Ответ 6

R не позволяет делать то, что вы хотите, то есть:

forp (i in 1:10) {
    #do something
}

Но вы можете создать какой-то объект и цикл итератора, используя while():

while(nextStep(m)){sleep.milli(20)}

Теперь у вас есть проблема с тем, что m есть и как вы делаете nextStep(m), чтобы иметь побочные эффекты на m, чтобы он возвращал FALSE в конце вашего цикла. Я написал простые итераторы, которые это делают, а также итераторы MCMC, которые позволяют вам определять и тестировать период ожога и прореживания в вашем цикле.

Недавно на конференции пользователя R я увидел, что кто-то определил функцию "do", которая затем работала оператором, что-то вроде:

do(100) %*% foo()

но я не уверен, что это был точный синтаксис, и я не уверен, как его реализовать или кто его заложил... Возможно, кто-то еще помнит!

Ответ 7

Я предлагаю НАСТОЯЩИМ два решения, которые используют стандарт for синтаксиса, оба используют большой пакет прогресс от Габора Csárdi и Rich FitzJohn

• 1) мы можем временно или локально переопределить функцию for чтобы оборачивать base::for и поддерживать индикаторы выполнения.
• 2) мы можем определить неиспользуемые for<- и обернуть base::for использования синтаксиса pb → for(it in seq) {exp} где pb - индикатор выполнения, построенный с помощью progress::progress_bar$new().

Оба решения ведут себя стандартно для звонков:

• Значения, измененные на предыдущей итерации, доступны
• в случае ошибки измененные переменные будут иметь значение, которое они имели непосредственно перед ошибкой

Я упаковал свое решение и продемонстрирую их ниже, а затем пройдусь по коду

использование

#devtools::install_github("moodymudskipper/pbfor")
library(pbfor)

Использование pb_for()

По умолчанию pb_for() будет переопределить for функции для только один проход.

pb_for()
for (i in 1:10) {
  # DO SOMETHING
  Sys.sleep(0.5)
}

Используя параметры из progress::progress_bar$new():

pb_for(format = "Working hard: [:bar] :percent :elapsed", 
       callback = function(x) message("Were'd done!"))
for (i in 1:10) {
  # DO SOMETHING
  Sys.sleep(0.5)
}

Использование for<-

Единственное ограничение по сравнению со стандартом for вызова заключается в том, что первый аргумент должен существовать и не может иметь NULL.

i <- NA 
progress_bar$new() -> for (i in 1:10) {
  # DO SOMETHING
  Sys.sleep(0.5)
}

Мы можем определить пользовательский индикатор выполнения и, возможно, определить его удобно в скрипте инициализации или в одном профиле R.

pb <- progress_bar$new(format = "Working hard: [:bar] :percent :elapsed", 
       callback = function(x) ("Were'd done!"))
pb  -> for (i in 1:10) {
  # DO SOMETHING
  Sys.sleep(0.5)
}

Для вложенных индикаторов мы можем использовать следующий трюк:

pbi <- progress_bar$new(format = "i: [:bar] :percent\n\n")
pbj <- progress_bar$new(format = "j: [:bar] :percent  ")
i <- NA
j <- NA
pbi  -> for (i in 1:10) {
  pbj  -> for (j in 1:10) {
    # DO SOMETHING
    Sys.sleep(0.1)
  }
}

обратите внимание, что из-за приоритета оператора единственный способ вызвать for<- и воспользоваться синтаксисом for вызовов - это использовать стрелку слева направо ´-> ´.

как они работают

pb_for()

pb_for() создает объект функции for в его родительской среде, а затем новый for:

• устанавливает индикатор выполнения
• изменяет содержимое цикла
• добавляет '*pb*'$tick() в конце выражения содержимого цикла
• передает его обратно на base::'for' в чистой среде
• присваивает при выходе все измененные или созданные переменные родительской среде.
• удаляет себя, если once TRUE (по умолчанию)

Обычно он чувствителен к переопределению оператора, но он очищает после себя и не влияет на глобальную среду, если используется в функции, поэтому я думаю, что он достаточно безопасен для использования.

for<-

Этот подход:

• не переопределяет for
• позволяет использовать шаблоны индикатора выполнения
• имеет, вероятно, более интуитивный API

Однако у него есть несколько недостатков:

• его первый аргумент должен существовать, что имеет место для всех функций присваивания (fun<-).
• он использует магию памяти, чтобы найти имя своего первого аргумента, поскольку это нелегко сделать с помощью функций присваивания, это может привести к снижению производительности, и я не уверен на 100% в надежности
• нам нужен пакет pryr

Что оно делает:

• найти имя первого аргумента, используя вспомогательную функцию
• клонировать ввод индикатора выполнения
• отредактируйте его, чтобы учесть количество итераций цикла (длина второго аргумента for<-

После этого это похоже на то, что описано для pb_for() в разделе выше.

Код

pb_for()

pb_for <-
  function(
    # all args of progress::progress_bar$new() except 'total' which needs to be
    # infered from the 2nd argument of the 'for' call, and 'stream' which is
    # deprecated
    format = "[:bar] :percent",
    width = options("width")[[1]] - 2,
    complete = "=",
    incomplete = "-",
    current =">",
    callback = invisible, # doc doesn't give default but this seems to work ok
    clear = TRUE,
    show_after = .2,
    force = FALSE,
    # The only arg not forwarded to progress::progress_bar$new()
    # By default 'for' will self detruct after being called
    once = TRUE) {

    # create the function that will replace 'for'
    f <- function(it, seq, expr){
      # to avoid notes at CMD check
      '*pb*' <- IT <- SEQ <- EXPR <- NULL

      # forward all arguments to progress::progress_bar$new() and add
      # a 'total' argument computed from 'seq' argument
      pb <- progress::progress_bar$new(
        format = format, width = width, complete = complete,
        incomplete = incomplete, current = current,
        callback = callback,
        clear = clear, show_after = show_after, force = force,
        total = length(seq))

      # using on.exit allows us to self destruct 'for' if relevant even if
      # the call fails.
      # It also allows us to send to the local environment the changed/created
      # variables in their last state, even if the call fails (like standard for)
      on.exit({
        vars <- setdiff(ls(env), c("*pb*"))
        list2env(mget(vars,envir = env), envir = parent.frame())
        if(once) rm('for',envir = parent.frame())
      })

      # we build a regular 'for' loop call with an updated loop code including
      # progress bar.
      # it is executed in a dedicated environment and the progress bar is given
      # a name unlikely to conflict
      env <- new.env(parent = parent.frame())
      env$'*pb*' <-  pb
      eval(substitute(
        env = list(IT = substitute(it), SEQ = substitute(seq), EXPR = substitute(expr)),
        base::'for'(IT, SEQ,{
          EXPR
          '*pb*'$tick()
        })), envir = env)
    }
    # override 'for' in the parent frame
    assign("for", value = f,envir = parent.frame())
  }

for<- (и fetch_name())

'for<-' <-
  function(it, seq, expr, value){
    # to avoid notes at CMD check
    '*pb*' <- IT <- SEQ <- EXPR <- NULL
    # the symbol fed to 'it' is unknown, R uses '*tmp*' for assignment functions
    # so we go get it by inspecting the memory addresses
    it_chr <- fetch_name(it)
    it_sym <-as.symbol(it_chr)

    #  complete the progress bar with the 'total' parameter
    # we need to clone it because progress bars are environments and updated
    # by reference
    pb <- value$clone()
    pb$.__enclos_env__$private$total <- length(seq)

    # when the script ends, even with a bug, the values that have been changed
    # are written to the parent frame
    on.exit({
      vars <- setdiff(ls(env), c("*pb*"))
      list2env(mget(vars, env),envir = parent.frame())
    })

    # computations are operated in a separate environment so we don't pollute it
    # with it, seq, expr, value, we need the progress bar so we name it '*pb*'
    # unlikely to conflict by accident
    env <- new.env(parent = parent.frame())
    env$'*pb*' <-  pb
    eval(substitute(
      env =  list(IT = it_sym, SEQ = substitute(seq), EXPR = substitute(expr)),
      base::'for'(IT, SEQ,{
        EXPR
        '*pb*'$tick()
      })), envir = env)

    # because of the 'fun<-' syntax we need to return the modified first argument
    invisible(get(it_chr,envir = env))
  }

помощники:

fetch_name <- function(x,env = parent.frame(2)) {
  all_addresses       <- sapply(ls(env), address2, env)
  all_addresses       <- all_addresses[names(all_addresses) != "*tmp*"]
  all_addresses_short <- gsub("(^|<)[0x]*(.*?)(>|$)","\\2",all_addresses)

  x_address       <- tracemem(x)
  untracemem(x)
  x_address_short <- tolower(gsub("(^|<)[0x]*(.*?)(>|$)","\\2",x_address))

  ind    <- match(x_address_short, all_addresses_short)
  x_name <- names(all_addresses)[ind]
  x_name
}

address2 <- getFromNamespace("address2", "pryr")

Ответ 8

Спасибо всем за ваши добрые ответы! Поскольку ни один из них не соответствовал моим дурацким потребностям, я начал украсть некоторые части данных ответов и составил совершенно индивидуальную версию:

forp <- function(iis, .fun) {
    .fun <- paste(deparse(substitute(.fun)), collapse='\n')
    .fun <- gsub(' <- ', ' <<- ', .fun, fixed=TRUE)
    .fun <- paste(.fun, 'index.current <- 1 + index.current; setTkProgressBar(pb, index.current, label=paste( round(index.current/index.max*100, 0), "% ready!"))', sep='\n')
    ifelse(is.numeric(iis), index.max <- max(iis), index.max <- length(iis))
    index.current <- 1
    pb <- tkProgressBar(title = "Working hard:", min = 0, max = index.max, width = 300) 
    for (i in iis) eval(parse(text=paste(.fun)))
    close(pb)
}

Это довольно длинная для простой функции, подобной этой, но зависит только от базы (естественно, и tcltk) и имеет некоторые приятные функции:

• может использоваться для выражений, а не только для функций,
• вам не нужно использовать <<- в ваших выражениях для обновления глобальной среды, <- заменяются на <<- в данном выражении. Ну, это может раздражать кого-то.
• может использоваться с нечисловыми индексами (см. ниже). Вот почему код стал таким длинным:)

Использование похоже на for, за исключением того, что вам не нужно указывать часть i in, и вы должны использовать i как индекс в цикле. Другим недостатком является то, что я не нашел способ захватить часть {...}, указанную после функции, поэтому это должно быть включено в параметры.

Пример # 1: Основное использование

> forp(1:1000, {
+   a<-i
+ })
> a
[1] 1000

Попробуйте увидеть аккуратный индикатор выполнения на вашем компьютере!:)

Пример # 2: Цитирование через некоторые символы

> m <- 0
> forp (names(mtcars), {
+   m <- m + mean(mtcars[,i])
+ })
> m
[1] 435.69