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

我想制作一个应用程序 2actionButtons: 1) 在加载之前提交更改selectizeInput2）绘制绘图。

我知道如何添加spinner单击后actionButton但大多数情况是当你想展示情节时添加的。 但是，是否可以添加一个spinner不显示任何情节？ 在这种特殊情况下，我想在单击“提交”后显示一个微调器，直到selectizeInput从“选择选项卡”加载。正如您所看到的我附加的示例，加载所有选项需要一些时间（因为文件有 25000 行）。

单击第二个后我已经有了一个微调器actionButton（显示情节）但我还需要一个。

我创建了一个示例，但由于某种原因，该图未显示在闪亮的应用程序中，而是出现在 R 的窗口中（我不知道为什么，但我添加该图只是为了向您展示如何放置第二个微调器。我想要一个类似的，但与第一个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在服务器端，如警告所示：

警告：选择输入“数字”包含大量 选项;考虑使用服务器端 selectize 来大幅改进 表现。请参阅 ?selectizeInput 帮助的详细信息部分 话题。

此外我切换到ggplot2关于plotOutput- 请参见这个相关帖子 https://stackoverflow.com/questions/29583849/save-a-plot-in-an-object.

显示微调器selectizeInput在更新选择时我们需要知道更新需要多长时间。这些信息可以通过收集Shiny的JS事件 https://shiny.rstudio.com/articles/js-events.html- 另请参阅本文 https://shiny.rstudio.com/articles/communicating-with-js.html.

最后，我们可以显示不存在的输出的微调器，因此我们能够控制微调器的显示时间（请参阅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))- 您的链接有一天可能会离线）：

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")