plotly 不会消失 + (action Button) 闪亮

Question

我创建了一个简单的闪亮应用程序，基于 mtcars 数据集，通过单击 checkboxInput 可以有一个 plotly 选项，但是当我取消单击它时，它不会消失。当我取消单击 checkboxInput 时，如何 disappear/disable 情节。

此外，我想在应用程序中添加一个操作按钮，因此只有在单击操作按钮后才会出现更改。

感谢所有帮助

library(shiny)
library(plotly)

dataset <- mtcars 

ui <- shinyUI(pageWithSidebar(
  
  headerPanel("Mtcars"),
  sidebarPanel(sliderInput('sampleSize', 'Sample Size', min=10, max=nrow(dataset),
                           value=min(10, nrow(dataset)), step=5, round=0),
               selectInput('x', 'X', names(dataset)),
               selectInput('y', 'Y', names(dataset), names(dataset)[[2]]),
               selectInput('color', 'Color', c('None', names(dataset))),
               checkboxInput('smooth', 'Smooth'),
               selectInput('facet_row', 'Facet Row', c(None='.', names(dataset))),
               selectInput('facet_col', 'Facet Column', c(None='.', names(dataset))),
               hr(),
               checkboxInput("plotly1", "Reactive plot!",value = FALSE, width=140),
               actionButton("plot", "Plot!")
               
               
  ),
  mainPanel(
    plotOutput('plot'),
    hr(),
    hr(),
    plotlyOutput("plot2")
    
    )
))

server<- shinyServer(function(input, output) { 
  
  dataset <- reactive( { mtcars[sample(nrow(mtcars), input$sampleSize),] }) 
  
  
  gragh <- reactive({
    p <- ggplot(dataset(), aes_string(x=input$x, y=input$y)) + geom_point()
    if (input$color != 'None')
      p <- p + aes_string(color=input$color)
    facets <- paste(input$facet_row, '~', input$facet_col)
    if (facets != '. ~ .')
      p <- p + facet_grid(facets)
    
    if (input$smooth)
      p <- p + geom_smooth()
    print(p)
    
    if (input$plotly1) {
      output$plot2 <- renderPlotly({
        ggplotly(p)
        
      })
      
      
    }
    
    
  })
  
  output$plot <- renderPlot({
  gragh()
  })
  
  
  })


shinyApp(ui, server)

Answer 1

将if-statement移到renderPlotly()内：

output$plot2 <- renderPlotly({
  if (input$plotly1) {
    ggplotly(p)
  }
})

输出在创建一次后仍然存在，依赖于反应性来改变它们的结果。

Answer 2

我建议通过 conditionalPanel 基于 UI 的方法。这避免了服务器功能中不必要的 re-rendering 图表，因此响应更快。

您可以使用 bindEvent 通过 actionButton 触发绘图：

library(shiny)
library(plotly)

dataset <- mtcars

ui <- shinyUI(pageWithSidebar(
  headerPanel("Mtcars"),
  sidebarPanel(
    sliderInput(
      'sampleSize',
      'Sample Size',
      min = 10,
      max = nrow(dataset),
      value = min(10, nrow(dataset)),
      step = 5,
      round = 0
    ),
    selectInput('x', 'X', names(dataset)),
    selectInput('y', 'Y', names(dataset), names(dataset)[[2]]),
    selectInput('color', 'Color', c('None', names(dataset))),
    checkboxInput('smooth', 'Smooth'),
    selectInput('facet_row', 'Facet Row', c(None = '.', names(dataset))),
    selectInput('facet_col', 'Facet Column', c(None = '.', names(dataset))),
    hr(),
    checkboxInput(
      "plotly1",
      "Interactive plot!",
      value = FALSE,
      width = 140
    ),
    actionButton("plot", "Plot!")
  ),
  mainPanel(
    plotOutput('plot'),
    hr(),
    hr(),
    conditionalPanel("input.plotly1 === true", plotlyOutput("plot2"))
  )
))

server <- shinyServer(function(input, output, session) {
  dataset <- reactive({
      mtcars[sample(nrow(mtcars), input$sampleSize), ]
    })
  gragh <- reactive({
    p <-
      ggplot(dataset(), aes_string(x = input$x, y = input$y)) + geom_point()
    if (input$color != 'None')
      p <- p + aes_string(color = input$color)
    facets <- paste(input$facet_row, '~', input$facet_col)
    if (facets != '. ~ .')
      p <- p + facet_grid(facets)
    
    if (input$smooth)
      p <- p + geom_smooth()
    
    p
  }) |> bindEvent(input$plot)
  
  output$plot <- renderPlot({
    gragh()
  })
  
  output$plot2 <- renderPlotly({
    ggplotly(gragh())
  })
})

shinyApp(ui, server)

plotly 不会消失 + (action Button) 闪亮

plotly won't disappear + (action Button) shiny

r

shiny

r-plotly