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)

每当用户从前端单击刷新按钮时，它将执行数据更新。数据刷新完成后，会出现一个窗口提示，说明数据已刷新。我的问题是我还想要一些指示＆＃39;而数据正在刷新。我尝试使用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)

闪亮的应用会在循环中使用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()放入源中（在循环中或行之间）。享受

在采购脚本时，在R闪亮时显示加载栏

1 个答案: