Сверкающее обновление во время работы функции?

Question

При нажатии «Start Ramp», я ожидаю, что дисплей будет обновляться с новым значением счетчика каждый раз, когда add.to.counter (ticks_per_second) запускается в течение для l oop, но обновление происходит только в конце из за oop. Это потому, что основная функция линейного изменения все еще выполняется? Как я могу сделать это обновление таким, чтобы оно обновлялось при каждом изменении значения счетчика, пока основная функция все еще работает?

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  sidebarLayout(
    sidebarPanel(
      actionButton("start", "Start Ramp")
    ),

    mainPanel(
    tags$b("Simple counter using reactiveValues() - An example"),
    br(),
    actionButton("add1", "+ 1"),
    actionButton("sub1", "- 1"),
    actionButton("reset", "set to 0"),
    br(),
    textOutput("count")
    )
))

server <- function(input, output, session) {

  counter <- reactiveValues(countervalue = 0) # Defining & initializing the reactiveValues object

  add.to.counter <- function(val) {
    counter$countervalue <<- counter$countervalue + val 
  }

  ramp <- function(length_of_ramp, ticks_per_second) {
    # length of ramp in seconds
    # ticks: divide each second into this number of ticks

    ticks <- length_of_ramp*ticks_per_second

    for (n in 1:ticks) {
      shinyjs::delay(ticks_per_second*1000, add.to.counter(ticks_per_second))
    }

  }

  observeEvent(input$start, { ramp(length_of_ramp = 10, ticks_per_second = 1) }
  )

    observeEvent(input$add1, {
      counter$countervalue <- counter$countervalue + 1     # if the add button is clicked, increment the value by 1 and update it
    })
    observeEvent(input$sub1, {
      counter$countervalue <- counter$countervalue - 1  # if the sub button is clicked, decrement the value by 1 and update it
    })
    observeEvent(input$reset, {
      counter$countervalue <- 0                     # if the reset button is clicked, set the counter value to zero
    })
    output$count <- renderText({
      paste("Counter Value is ", counter$countervalue)   # print the latest value stored in the reactiveValues object
    })


}


# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

Я думаю, что проблема в том, что shinyjs::delay() задерживается только один раз, даже когда вызывается в пределах для l oop. Я не знаю, как заставить shinyjs::delay() задерживать каждую итерацию для l oop. На самом деле, я подозреваю, что это невозможно, учитывая, что shinyjs::delay() работает только в интерактивных сеансах или контексте, тогда как сам по себе l oop не является интерактивным или реактивным контекстом.

Чтобы достичь того, что вы хотите, мне пришлось немного переосмыслить код сервера. Я использовал invalidateLater, isolate и reactiveValue, чтобы заставить вывод текста обновляться каждую секунду и для вычисления счетчика каждую секунду таким образом, чтобы каждую секунду счетчик обновлялся в текстовый вывод. Так как это будет выполняться вечно, пока не будут изменены некоторые значения, я использовал операторы if для условной печати текстового вывода.

Полный код ниже:

library(shiny)

ui <- fluidPage(
  useShinyjs(),
  sidebarLayout(
    sidebarPanel(
      actionButton("start", "Start Ramp")
    ),

    mainPanel(
      tags$b("Simple counter using reactiveValues() - An example"),
      br(),
      actionButton("add1", "+ 1"),
      actionButton("sub1", "- 1"),
      actionButton("reset", "set to 0"),
      br(),
      uiOutput("count")
    )
  ))

server <- function(input, output, session) {


  length_of_ramp = 10; ticks_per_second = 1

  ticks <- length_of_ramp*ticks_per_second

  counter <- reactiveValues(countervalue = 0, forLoop = ticks, loopCount = Inf, finalCount = 0)

  observeEvent(input$start, {

    counter$loopCount <- -1

  })

  observe({
    invalidateLater(1000)
    counter$loopCount <- isolate(counter$loopCount) + 1

    if(counter$loopCount == ticks){counter$finalCount <- counter$loopCount}
    print(counter$finalCount)
  })

  observeEvent(input$add1, {
    counter$countervalue <- counter$countervalue + 1     # if the add button is clicked, increment the value by 1 and update it
  })
  observeEvent(input$sub1, {
    counter$countervalue <- counter$countervalue - 1  # if the sub button is clicked, decrement the value by 1 and update it
  })
  observeEvent(input$reset, {
    counter$countervalue <- 0                     # if the reset button is clicked, set the counter value to zero
  })


  output$count <- renderUI({

    invalidateLater(millis = 1000, session)

    if(counter$loopCount < ticks){
      counter$countervalue <- isolate(counter$countervalue) + ticks_per_second
      paste("Counter Value is ", isolate(counter$countervalue))
    }else if (counter$loopCount == Inf || counter$loopCount == 0 || counter$finalCount == ticks) {
      paste("Counter Value is ", isolate(counter$countervalue))
    }
  })


}

shinyApp(ui, server)

Answer 2

Ваше использование Sys.sleep() в

library(shiny)

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      actionButton("start", "Start Ramp")
    ),

    mainPanel(
      tags$b("Simple counter using reactiveValues() - An example"),
      br(),
      actionButton("add1", "+ 1"),
      actionButton("sub1", "- 1"),
      actionButton("reset", "set to 0"),
      br(),
      textOutput("count")
    )
  ))

server <- function(input, output, session) {

  add.to.counter <- function(val) {
    counter$countervalue <<- counter$countervalue + val 
  }

  ramp <- function(length_of_ramp, ticks_per_second) {
    # length of ramp in seconds
    # ticks: divide each second into this number of ticks

    ticks <- length_of_ramp*ticks_per_second
    for (n in 1:ticks) {
      add.to.counter(ticks_per_second)
      # Sys.sleep(1/ticks_per_second)
    }
  }

  observeEvent(input$start, { ramp(length_of_ramp = 10, ticks_per_second = 1) }
  )

  counter <- reactiveValues(countervalue = 0) # Defining & initializing the reactiveValues object

  observeEvent(input$add1, {
    counter$countervalue <- counter$countervalue + 1     # if the add button is clicked, increment the value by 1 and update it
  })
  observeEvent(input$sub1, {
    counter$countervalue <- counter$countervalue - 1  # if the sub button is clicked, decrement the value by 1 and update it
  })
  observeEvent(input$reset, {
    counter$countervalue <- 0                     # if the reset button is clicked, set the counter value to zero
  })
  output$count <- renderText({
    paste("Counter Value is ", counter$countervalue)   # print the latest value stored in the reactiveValues object
  })


}


# Run the application 
shinyApp(ui = ui, server = server)