Как рассчитать реактивную функцию в приложении Shiny в т - PullRequest
Новая
       61

Как рассчитать реактивную функцию в приложении Shiny в т

0 голосов
/ 14 мая 2018

У меня есть функция, которую я хотел бы рассчитать, а затем отобразить в пользовательском интерфейсе, сколько времени потребовалось для выполнения этой функции.Как я могу получить время выполнения этой функции повторно?Я попытался поместить переменную в реактивную функцию, вокруг функции и т. Д. Я просто хочу определить время, необходимое для запуска реактивной функции, а затем отобразить ее.Я пытаюсь не использовать дополнительные пакеты. 

library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(

  sidebarPanel(
    # User Input Text  Box
    textInput(inputId = "userText",
          label = "",
          placeholder = "Type in a partial sentence here..."),
    verbatimTextOutput(outputId = "textInput", placeholder = TRUE),

    # Show amount of execution time
    verbatimTextOutput(outputId = "timer", placeholder = TRUE)  
))

server <- function(input, output) {

  # Declare Timer variables
  startTime <- Sys.time()
  endTime <- Sys.time()

  # Some function to time: Trivial Paste Function
  textToDisplay <- reactive({
    req(input$userText)
    startTime <- Sys.time()
    textToDisplay <- paste("This is the user input text: ", input$userText)
    endTime <- Sys.time()
    return(textToDisplay)
  })

  # Display pasted text
  output$textInput <- renderText({
    req(input$userText)
    textToDisplay()

  })

  # Display execution time
  output$timer <- renderText({
    req(input$userText)
    paste0("Executed in: ",((endTime - startTime)*1000)," milliseconds")
  })
}

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

Приведенный выше код не обновляет и не отображает правильную разницу во времени правильно.

Ответы [ 3 ]

0 голосов
/ 14 мая 2018

Я думаю, что там есть немного ненужного кода. Ваше определение startTime и endTime как в пределах server, так и в отдельных реактивных чанах сбивает с толку (и вас, и читателей); скорее всего, оба местоположения не требуются, и, поскольку я предпочитаю использовать system.time, я предлагаю, чтобы ни одно из этих мест не было необходимым.

Есть два способа получить два возвращаемых значения (данные и истекшее время) из чанка: (1) вернуть list и (2) reactiveValues().

Сохранение ваших ui и shinyApp ...

Для первого варианта (list) компонент server становится: 

server <- function(input, output) {
  mydat <- eventReactive(input$userText, {
    req(input$userText)
    tm <- system.time({
      Sys.sleep(runif(1))
      out <- paste("This is the user input text:", sQuote(input$userText))
    })
    list(x=out, elapsed=tm['elapsed'])
  })
  # Display pasted text
  output$textInput <- renderText({
    req(mydat())
    mydat()$x
  })
  # Display execution time
  output$timer <- renderText({
    req(mydat())
    paste0("Executed in: ", round(mydat()$elapsed*1000), " milliseconds")
  })
}

Для второго варианта попробуйте: 

server <- function(input, output) {
  times <- reactiveVal()
  mydat <- reactiveVal()
  # operates in side-effect
  observeEvent(input$userText, {
    req(input$userText)
    tm <- system.time({
      Sys.sleep(runif(1))
      out <- paste("This is the user input text:", sQuote(input$userText))
    })
    times(tm['elapsed'])
    mydat(out)
  })
  # Display pasted text
  output$textInput <- renderText({
    req(mydat())
    mydat()
  })
  # Display execution time
  output$timer <- renderText({
    req(times())
    paste0("Executed in: ", round(times()*1000), " milliseconds")
  })
}

(Вместо двух reactiveVal() переменных вы также можете использовать предложение @ divibisan для использования reactiveValues(), того же конечного результата.)

0 голосов
/ 14 мая 2018

Я использовал подход, который представляет собой комбинацию ваших предложений @ r2evans и @divibisan. Я использовал реактивные значения, потому что я думаю, что они читаемы пользователем и могут быть легко распространены на другие области. Я использовал system.time как предложено. Когда функция запускается, она обновляет реактивные значения, и оператор return контролирует возврат соответствующего значения из функции. 

server <- function(input, output) {
  options(digits.secs=2)

  # Declare Timer variables
  rv <- reactiveValues(
    exTime = Sys.time()
  )

  # Trivial Paste Function
  textToDisplay <- reactive({
    req(input$userText)
    t <- system.time({
      textToDisplay <- paste("This is the user input text: ", 
                             input$userText)
      })
    rv$exTime <- t[[3]]
    return(textToDisplay)
  })

  # Display pasted text
  output$textInput <- renderText({
    req(input$userText)
    textToDisplay()
  })

  # Display execution time
  output$timer <- renderText({
    req(input$userText)
    paste0("Executed in: ",((rv$exTime)*1000)," milliseconds")
  })
}

Как предположил @divibisan, здесь будет отображаться 0, потому что код работает так быстро. Вы можете увеличить цифры, возвращаемые с system.time() на options(digits.secs=2), которые я добавил в верхней части кода сервера. Для моих целей с реальной функцией это дало мне 10 миллисекундную точность работы в Windows.

0 голосов
/ 14 мая 2018

Ах, проблема в том, что startTime и endTime не являются реактивными значениями, поэтому при их изменении они не приводят к аннулированию и повторному запуску renderText и не сохраняются должным образом вне реактивных выражений. .

Просто определите reactiveValues объект и сделайте startTime и endTime частью этого.

Заменить часть, в которой вы определяете переменные таймера: 

rv <- reactiveValues()

Затем, каждый раз, когда вы звоните по startTime и endTime, используйте rv$startTime и rv$endTime.

Вы все равно не увидите результат, потому что textToDisplay работает слишком быстро, но если вы внесете эти изменения и добавите Sys.sleep(2) в textToDisplay, вы увидите, что он работает правильно.

...