Search code examples
rshinyr-plotly

plotly won't disappear + (action Button) shiny


I have created a simple shiny app, based on mtcars dataset, with the ability to have a plotly option, by clicking on the checkboxInput, however when I unclick it, it won't disappear. How can I disappear/disable the plotly when I unclick the checkboxInput.

Also, I would like to add an actionbutton to the app, so only after clicking on the actionbutton the changes would appear.

Grateful for all help

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)

Solution

  • I'd suggest a UI based approach via conditionalPanel. This avoids unnecessary re-rendering of the plotly chart in the server function and therefore is more responsive.

    You can use bindEvent to trigger plotting with the 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)