shinycssloaders 包中的微调器在按下操作按钮之前加载

Question

我正在创建一个带有一些选项卡的闪亮应用程序，我正在使用 shinycssloaders 包以便在按下 actionButton 后显示微调器。我看到这个 post 因为我遇到了同样的问题...我遵循了它给 post 的解决方案，但是因为我的应用程序不同（它有 tabPanels ，它不能正常工作，微调器仍然出现）。

例如，如果您在第一个选项卡（选择）中单击“显示绘图”，然后想要进行 log2 转换或计算平方根（第三个选项卡，计算），则在单击actionButton 微调器出现并且绘图更新。当您想要更改标题（第二个选项卡）时，情况也是如此。

有人知道怎么解决吗？

非常感谢

代码：

library(shiny)
library(magrittr)
library(DT)
library(ggplot2)
library(shinycssloaders)
new_choices <- setNames(names(mtcars), names(mtcars))


ui <- fluidPage(
  
  # Application title
  titlePanel("My shiny app"),
  
  sidebarLayout(
    sidebarPanel(
      
      tabsetPanel(
          tabPanel("Selection",
                  selectInput("x_axis", "Choose x axis",
                            choices = new_choices),
                  
                  selectInput("y_axis", "Choose y axis",
                              choices = new_choices),
               
                  hr(),
                ),
                  
          tabPanel("Titles",
                    hr(),
              
                    textInput(inputId = "title", "You can write the title:",  value = "This is the title"),
                    textInput(inputId = "xlab", "You can re-name the x-axis:",  value = "x-axis...."),
                    textInput(inputId = "ylab", "You can re-name the y-axis:",  value = "y-axis ...."),
          
                  ),
      
      
          tabPanel("Calculations", 
                    hr(),
                    
                    checkboxInput("log2", "Do the log2 transformation", value = F),
                    checkboxInput("sqrt", "Calculate the square root", value = F),
                   
                   )

          ),
      actionButton(inputId = "drawplot", label = "Show the plot")
    
      ),
              
              # Show a plot of the generated distribution
              mainPanel(
               # plotOutput("plot") 
                uiOutput("spinner"),
                
              )
      )
    )


server <- function(input, output, session) {
  

  data <- reactive({
    mtcars
  })
  
  
  filtered_data <- reactive({
    data <- data()
    if(input$log2 == TRUE){
      data <- log2(data+1)
    }
    if(input$sqrt == TRUE){
      data <- sqrt(data)
    }
    return(data)
    
  })
  
  
  
  observeEvent(input$drawplot, {
    
    output$spinner <- renderUI({
      withSpinner(plotOutput("plot"), color="black")
    })
    
    output$plot <- renderPlot({
      Sys.sleep(3)
      ggplot() +
        geom_point(data = filtered_data(),
                   aes_string(x = input$x_axis, y = input$y_axis)) +
        xlab(input$xlab) +
        ylab(input$ylab) +
        ggtitle(input$title)
    })
    
  })

  
}

shinyApp(ui, server)

Answer 1

你需要isolate你不想在里面触发渲染事件的表达式renderPlot

library(shiny)
library(magrittr)
library(DT)
library(ggplot2)
library(shinycssloaders)
new_choices <- setNames(names(mtcars), names(mtcars))


ui <- fluidPage(
    
    # Application title
    titlePanel("My shiny app"),
    
    sidebarLayout(
        sidebarPanel(
            
            tabsetPanel(
                tabPanel("Selection",
                         selectInput("x_axis", "Choose x axis",
                                     choices = new_choices),
                         
                         selectInput("y_axis", "Choose y axis",
                                     choices = new_choices),
                         
                         hr(),
                ),
                
                tabPanel("Titles",
                         hr(),
                         
                         textInput(inputId = "title", "You can write the title:",  value = "This is the title"),
                         textInput(inputId = "xlab", "You can re-name the x-axis:",  value = "x-axis...."),
                         textInput(inputId = "ylab", "You can re-name the y-axis:",  value = "y-axis ...."),
                         
                ),
                
                
                tabPanel("Calculations", 
                         hr(),
                         
                         checkboxInput("log2", "Do the log2 transformation", value = F),
                         checkboxInput("sqrt", "Calculate the square root", value = F),
                         
                )
                
            ),
            actionButton(inputId = "drawplot", label = "Show the plot")
            
        ),
        
        # Show a plot of the generated distribution
        mainPanel(
            # plotOutput("plot") 
            uiOutput("spinner"),
            
        )
    )
)


server <- function(input, output, session) {
    
    
    data <- reactive({
        mtcars
    })
    
    
    filtered_data <- reactive({
        data <- data()
        if(input$log2 == TRUE){
            data <- log2(data+1)
        }
        if(input$sqrt == TRUE){
            data <- sqrt(data)
        }
        return(data)
        
    })
    
    
    
    observeEvent(input$drawplot, {
        
        output$spinner <- renderUI({
            withSpinner(plotOutput("plot"), color="black")
        })
        
        output$plot <- renderPlot({
            Sys.sleep(3)
            ggplot() +
                geom_point(data = isolate(filtered_data()),
                           aes_string(x = isolate(input$x_axis), y = isolate(input$y_axis))) +
                xlab(isolate(input$xlab)) +
                ylab(isolate(input$ylab)) +
                ggtitle(isolate(input$title))
        })
        
    })
    
    
}

shinyApp(ui, server)

阅读更多关于闪亮反应性和隔离的信息：https://shiny.rstudio.com/articles/isolation.html

Answer 2

这样可以吗？我不确定是否了解您的所有要求。为了避免在启动时出现旋转器，我使用了 conditionalPanel。在服务器代码中，我做了一些更改。不建议在observer里面定义一些output

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

new_choices <- setNames(names(mtcars), names(mtcars))


ui <- fluidPage(
  
  # Application title
  titlePanel("My shiny app"),
  
  sidebarLayout(
    sidebarPanel(
      
      tabsetPanel(
        tabPanel(
          "Selection",
          selectInput("x_axis", "Choose x axis",
                      choices = new_choices),
          
          selectInput("y_axis", "Choose y axis",
                      choices = new_choices),
          
          hr(),
        ),
        
        tabPanel(
          "Titles",
          hr(),
          
          textInput(inputId = "title", "You can write the title:",  value = "This is the title"),
          textInput(inputId = "xlab", "You can re-name the x-axis:",  value = "x-axis...."),
          textInput(inputId = "ylab", "You can re-name the y-axis:",  value = "y-axis ...."),
          
        ),
        
        
        tabPanel(
          "Calculations", 
          hr(),
          
          checkboxInput("log2", "Do the log2 transformation", value = F),
          checkboxInput("sqrt", "Calculate the square root", value = F),
          
        )
        
      ),
      actionButton(inputId = "drawplot", label = "Show the plot")
      
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      conditionalPanel(
        condition = "input.drawplot > 0",
        style = "display: none;",
        withSpinner(plotOutput("plot"))
      )
    )
  )
)


server <- function(input, output, session) {
  
  data <- reactive({
    mtcars
  })
  
  
  filtered_data <- reactive({
    data <- data()
    if(input$log2 == TRUE){
      data <- log2(data+1)
    }
    if(input$sqrt == TRUE){
      data <- sqrt(data)
    }
    return(data)
  }) 
  
  gg <- reactive({
    ggplot() +
      geom_point(data = filtered_data(),
                 aes_string(x = input$x_axis, y = input$y_axis)) +
      xlab(input$xlab) +
      ylab(input$ylab) +
      ggtitle(input$title)
  }) %>% 
    bindEvent(input$drawplot)

  
  output$plot <- renderPlot({
    Sys.sleep(3)
    gg()
  })
  
}

shinyApp(ui, server)

shinycssloaders 包中的微调器在按下操作按钮之前加载

Spinner from shinycssloaders package loads before pressing the action button

r

shiny

spinner

shinycssloaders