如何在 selectizeInput 加载所有选项之前添加微调器? [闪亮的]

How to add a spinner before a selectizeInput has loaded all the choices? [Shiny]

我想用 2 actionButton 制作一个应用程序:1) 在加载 selectizeInput 之前提交更改和 2) 绘制情节。

我知道如何在单击 actionButton 后添加 spinner,但大多数情况是在您想要显示情节时添加的。 但是,是否可以在不显示任何情节的情况下添加 spinner ? 在这种特殊情况下,我想在单击“提交”后显示一个微调器,直到加载 'Selection tab' 中的 selectizeInput。如您所见,我附上了示例,加载所有选项需要一些时间(因为文件有 25000 行)。

单击第二个 actionButton(显示绘图)后,我已经有了一个微调器,但我还需要一个。

我创建了一个示例,但由于某种原因,该图未显示在闪亮的应用程序中,而是出现在 R 的 window 中(我不知道为什么,但我只是将图添加到向您展示我如何放置第二个微调器。我想要一个类似的但与第一个 actionButton.).

library(shiny)
library(shinycssloaders)


ui <- fluidPage(

      titlePanel("My app"),
      
      sidebarLayout(
        sidebarPanel(
          tabsetPanel(
            
            tabPanel("Submit",
                     checkboxInput("log2", "Log2 transformation", value = FALSE),
                     actionButton("submit", "Submit")
            ),
      
      
            tabPanel("Selection",
                     br(),
                     selectizeInput(inputId = "numbers", label = "Choose one number:", choices=character(0)),
                     actionButton("show_plot", "Show the plot")
            ))
    ),
    mainPanel(
      conditionalPanel(
        condition = "input.show_plot > 0",
        style = "display: none;",
        withSpinner( plotOutput("hist"),
                    type = 5, color = "#0dc5c1", size = 1))

    )
  )
)

server <- function(input, output, session) {
  
  data <- reactive({
    data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
    data[,1] <- as.character(data[,1])
    
    if(input$log2 == TRUE){
      cols <- sapply(data, is.numeric)
      data[cols] <- lapply(data[cols], function(x) log2(x+1))
    }

    return(data)
  })
  
  mylist <- reactive({
    req(data())
    data <- data()
    data <- data[,1]
    return(data)
  })
  
  # This is to generate the choices (gene list) depending on the user's input.
  observeEvent(input$submit, {
    updateSelectizeInput(
      session = session, 
      inputId = "numbers", 
      choices = mylist(), options=list(maxOptions = length(mylist()))
    )
  })
  
  v <- reactiveValues()
  observeEvent(input$show_plot, {
    data <- data()
    v$plot <- plot(x=data[,1], y=data[,2])
  })
  
  
  # If the user didn't choose to see the plot, it won't appear.
  output$hist <- renderPlot({
    req(data())
    if (is.null(v$plot)) return()
    
    if(input$show_plot > 0){
      v$plot
    }

  })
}

请问有人知道如何帮助我吗?

非常感谢

有点棘手。

首先,我会按照警告建议在服务器端更新 selectizeInput

Warning: The select input "numbers" contains a large number of options; consider using server-side selectize for massively improved performance. See the Details section of the ?selectizeInput help topic.

此外,关于 plotOutput 我切换到 ggplot2 - 请参阅

要在 selectizeInput 更新选项时显示微调器,我们需要知道更新需要多长时间。可以通过 shiny's JS events - please also see this article.

收集此信息

最后,我们可以显示一个不存在的输出的微调器,这样我们就可以控制微调器显示多长时间(参见 uiOutput("dummyid")):

library(shiny)
library(shinycssloaders)
library(ggplot2)

ui <- fluidPage(
  titlePanel("My app"),
  tags$script(HTML(
    "
     $(document).on('shiny:inputchanged', function(event) {
       if (event.target.id === 'numbers') {
         Shiny.setInputValue('selectizeupdate', true, {priority: 'event'});
       }
     });
     $(document).on('shiny:updateinput', function(event) {
       if (event.target.id === 'numbers') {
         Shiny.setInputValue('selectizeupdate', false, {priority: 'event'});
       }
     });
    
    "
  )),
  sidebarLayout(
    sidebarPanel(
      tabsetPanel(
        tabPanel("Submit",
                 checkboxInput("log2", "Log2 transformation", value = FALSE),
                 actionButton("submit", "Submit")
        ),
        tabPanel("Selection",
                 br(),
                 selectizeInput(inputId = "numbers", label = "Choose one number:", choices=NULL),
                 actionButton("show_plot", "Show the plot")
        ))
    ),
    mainPanel(
      uiOutput("plotProxy")
    )
  )
)

server <- function(input, output, session) {
  
  previousEvent <- reactiveVal(FALSE)
  choicesReady <- reactiveVal(FALSE)
  submittingData <- reactiveVal(FALSE)
  
  observeEvent(input$selectizeupdate, {
    if(previousEvent() && input$selectizeupdate){
      choicesReady(TRUE)
      submittingData(FALSE)
    } else {
      choicesReady(FALSE)
    }
    previousEvent(input$selectizeupdate)
  })
  
  data <- reactive({
    data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
    
    if(input$log2 == TRUE){
      cols <- sapply(data, is.numeric)
      data[cols] <- lapply(data[cols], function(x) log2(x+1))
    }
    return(data)
  })
  
  mylist <- reactive({
    req(data()[,1])
  })
  
  observeEvent(input$submit, {
    submittingData(TRUE)
    reactivePlotObject(NULL) # reset
    updateSelectizeInput(
      session = session, 
      inputId = "numbers", 
      choices = mylist(), options=list(maxOptions = length(mylist())),
      server = TRUE
    )
  })
  
  reactivePlotObject <- reactiveVal(NULL)
  observeEvent(input$show_plot, {
    reactivePlotObject(ggplot(data(), aes_string(x = names(data())[1], y = names(data())[2])) + geom_point())
  })
  
  output$hist <- renderPlot({
    reactivePlotObject()
  })
  
  output$plotProxy <- renderUI({
    if(submittingData() && !choicesReady()){
      withSpinner(uiOutput("dummyid"), type = 5, color = "#0dc5c1", size = 1)
    } else {
      conditionalPanel(condition = "input.show_plot > 0", withSpinner(plotOutput("hist"), type = 5, color = "#0dc5c1", size = 1), style = "display: none;")
    }
  })
}

shinyApp(ui, server)

您的示例数据的前 100 行(dput(head(data, 100)) - 您的 link 可能有一天会离线):

structure(list(Index = 1:100, Height.Inches. = c(65.78331, 71.51521, 
69.39874, 68.2166, 67.78781, 68.69784, 69.80204, 70.01472, 67.90265, 
66.78236, 66.48769, 67.62333, 68.30248, 67.11656, 68.27967, 71.0916, 
66.461, 68.64927, 71.23033, 67.13118, 67.83379, 68.87881, 63.48115, 
68.42187, 67.62804, 67.20864, 70.84235, 67.49434, 66.53401, 65.44098, 
69.5233, 65.8132, 67.8163, 70.59505, 71.80484, 69.20613, 66.80368, 
67.65893, 67.80701, 64.04535, 68.57463, 65.18357, 69.65814, 67.96731, 
65.98088, 68.67249, 66.88088, 67.69868, 69.82117, 69.08817, 69.91479, 
67.33182, 70.26939, 69.10344, 65.38356, 70.18447, 70.40617, 66.54376, 
66.36418, 67.537, 66.50418, 68.99958, 68.30355, 67.01255, 70.80592, 
68.21951, 69.05914, 67.73103, 67.21568, 67.36763, 65.27033, 70.84278, 
69.92442, 64.28508, 68.2452, 66.35708, 68.36275, 65.4769, 69.71947, 
67.72554, 68.63941, 66.78405, 70.05147, 66.27848, 69.20198, 69.13481, 
67.36436, 70.09297, 70.1766, 68.22556, 68.12932, 70.24256, 71.48752, 
69.20477, 70.06306, 70.55703, 66.28644, 63.42577, 66.76711, 68.88741
), Weight.Pounds. = c(112.9925, 136.4873, 153.0269, 142.3354, 
144.2971, 123.3024, 141.4947, 136.4623, 112.3723, 120.6672, 127.4516, 
114.143, 125.6107, 122.4618, 116.0866, 139.9975, 129.5023, 142.9733, 
137.9025, 124.0449, 141.2807, 143.5392, 97.90191, 129.5027, 141.8501, 
129.7244, 142.4235, 131.5502, 108.3324, 113.8922, 103.3016, 120.7536, 
125.7886, 136.2225, 140.1015, 128.7487, 141.7994, 121.2319, 131.3478, 
106.7115, 124.3598, 124.8591, 139.6711, 137.3696, 106.4499, 128.7639, 
145.6837, 116.819, 143.6215, 134.9325, 147.0219, 126.3285, 125.4839, 
115.7084, 123.4892, 147.8926, 155.8987, 128.0742, 119.3701, 133.8148, 
128.7325, 137.5453, 129.7604, 128.824, 135.3165, 109.6113, 142.4684, 
132.749, 103.5275, 124.7299, 129.3137, 134.0175, 140.3969, 102.8351, 
128.5214, 120.2991, 138.6036, 132.9574, 115.6233, 122.524, 134.6254, 
121.8986, 155.3767, 128.9418, 129.1013, 139.4733, 140.8901, 131.5916, 
121.1232, 131.5127, 136.5479, 141.4896, 140.6104, 112.1413, 133.457, 
131.8001, 120.0285, 123.0972, 128.1432, 115.4759)), row.names = c(NA, 
100L), class = "data.frame")