在获取脚本时在 R 中闪亮时显示加载栏

Question

我有一个闪亮的应用程序，它允许用户通过一个按钮在前端刷新数据，并显示数据。我的app.R如下：

library(shiny)
file_name <- "sample.csv"
bkg_color <- "red"

# Define UI for application
ui <- fluidPage(
  actionButton("refresh", "", icon("refresh") ),
  tableOutput("table"),
  uiOutput("slider")
)

# Define server logic required
server <- function(input, output, session) {
  observeEvent(input$refresh,{
    source("updatedata.R")
    showModal(modalDialog(
      title = "", 
      "Data refreshed", 
      easyClose = TRUE,
      footer = NULL
    ))
  })
  # observe the raw file, and refresh if there is change every 5 seconds
  raw <- reactivePoll(5000, session, 
                          checkFunc = function(){
                            if (file.exists(file_name))
                              file.info(file_name)$mtime[1]
                            else
                              ""
                          }, 
                          valueFunc = function(){
                           read.csv(file_name)
                          })
output$table <- renderTable(raw())      
output$slider <- renderUI({
    req(raw())
    tagList(
      # styling slider bar
      tags$style(HTML(paste0(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: ",
                            bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}"))),
      sliderInput("date","", 
                  min = min(raw()$v1), 
                  max = max(raw()$v1), 
                  value = max(raw()$v1))
    )

  })

}

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

我还有另一个用于更新数据的updatedata.R 脚本，如下所示：

file_name <- "sample.csv"
temp <- data.frame(v1 =runif(10, min = 0, max = 100), v2 = Sys.time() )
write.csv(x =temp, file = file_name,row.names = FALSE )
Sys.sleep(10)

每当用户从前端点击刷新按钮时，都会进行数据更新。 数据刷新完成后，有窗口提示说数据已刷新。 我的问题是我还希望在刷新数据时有“一些指示”。 我尝试使用shinycssloaders 包，并使用withSpinner(tableOutput("table"))，但这不符合我的需求。有什么我可以探索的选择吗？

Answer 1

这是用于衡量每条源代码的进度并告知正在评估哪条线的解决方案。 假设您的updatedata.R 文件：

file_name <- "sample.csv"
temp <- data.frame(v1 =runif(10, min = 0, max = 100), v2 = Sys.time() )
write.csv(temp,file_name,row.names = FALSE )
Sys.sleep(10)

Shiny 应用程序将在循环内使用 withProgress() 和 incProgress - 就像在 example 中一样，并打印评估哪一行源代码。使用eval(parse( text = l[i] ))在循环中逐行评估源代码

library(shiny)
file_name <- "sample.csv"
bkg_color <- "red"

# Define UI for application
ui <- fluidPage(
  actionButton("refresh", "", icon("refresh") ),
  tableOutput("table"),
  uiOutput("slider")
)

# Define server logic required
server <- function(input, output, session) {
  observeEvent(input$refresh,{

    l <- readLines("~/Documents/eclipse_projects/stackoverflow/updatedata.R")
    n <- length(l)
    withProgress(message = 'Making plot', value = 0, {
      for (i in 1:n) {
        eval(parse(text=l[i]))
        incProgress(1/n, detail = paste("Doing part", l[i]))
      }
    })
    showModal(modalDialog(
      title = "", 
      "Data refreshed", 
      easyClose = TRUE,
      footer = NULL
    ))
  })
  # observe the raw file, and refresh if there is change every 5 seconds
  raw <- reactivePoll(5000, session, 
                      checkFunc = function(){
                        if (file.exists(file_name))
                          file.info(file_name)$mtime[1]
                        else
                          ""
                      }, 
                      valueFunc = function(){
                        read.csv(file_name)
                      })
  output$table <- renderTable(raw())      
  output$slider <- renderUI({
    req(raw())
    tagList(
      # styling slider bar
      tags$style(HTML(paste0(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: ",
                             bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}"))),
      sliderInput("date","", 
                  min = min(raw()$v1), 
                  max = max(raw()$v1), 
                  value = max(raw()$v1))
    )

  })

}

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

或者，您可以将incProgress() 放在源代码中（在循环中或行之间）。 享受