Bootstrap Modal Multiple Conditions R Shiny

Question

I need to only display a BS modal when a button is pressed and and a condition on a variable is met.

This is a simple app that demonstrates what the challenge is. I need to display a BS modal when num_rows >= 500, and the submit button is fired, not just when the submit button is fired.

I am aware this could be done with a conditionalPanel using input.slider as one of the conditions, but in my real project it is much more complicated than this, and the BS modal/conditional panel needs to depend on both a button (user input) and a variable assigned in the server.

library(shiny)
library(shinyBS)

data = matrix(rnorm(1000*10, 0, 1), nrow = 1000)

ui <- fluidPage(
  fluidRow(
    column(width = 4,
           sliderInput("slider", "Choose Number of Rows to Display", 0, 1000, value = NULL),
           submitButton('Submit'),
           bsModal("modalExample", "Yes/No", "submit", size = "small", wellPanel(
             p(div(HTML("<strong>Warning: </strong> you have chosen to display a large
                        number of rows. Are you sure you want to proceed?"))),
             actionButton("no_button", "Yes"),
             actionButton("yes_button", "No")
             ))
    ),
    column(width = 8,
           tableOutput('data')
    )
  )
)

server <- shinyServer(function(input, output, server){
  observe({
    num_rows <- input$slider

    if(num_rows >= 500){
      #
      # ACTIVATE MODAL PANEL
      #
      observeEvent(input$no_button, {
        # Do not show table
      })
      observeEvent(input$yes_button, {
        output$table <- renderTable(data)
      })
    } else{  # Display table normally if number of rows is less than 500
      output$table <- renderTable(data)
    }
  })

})


shinyApp(ui, server)

Answer 1

Have a look at the following code. I disabled the action button if num_rows<500 with the package shinyjs. If num_rows>=500 the action button becomes available to trigger the popup. To update the number of rows selected with the slider you'll have to press the submit button every time. Hope this helps or gets you some ideas. For now I have not implemented your warning message (that did not work for me). Another issue: the slider and display for the pop up only work towards increasing number of rows, not decreasing afterwards. If you find a solution for that, pls share =)

library(shiny)
library(shinyBS)
library(shinyjs)

data = matrix(rnorm(1000*10, 0, 1), nrow = 1000)

data1=data[(1:500),]
head(data)
ui <- fluidPage(
  fluidRow(
    column(width = 4,
           sliderInput("slider", "Choose Number of Rows to Display", 0, 1000, value = NULL),
           submitButton('Submit'),
           actionButton('Show','Show'),
           useShinyjs(),
           bsModal("modalExample",'Yes/No','Show', size = "large",tableOutput("tab")
#                    wellPanel(
#              p(div(HTML("<strong>Warning: </strong> you have chosen to display a large
#                         number of rows. Are you sure you want to proceed?")
#                    )))
               )),
    column(width = 8,tableOutput('table'))))

server <- function(input, output)({
observe({
  num_rows = input$slider 

 if(num_rows<500 &num_rows!=0) {
   shinyjs::disable('Show')
 output$table <- renderTable({
   data = data1[(1:num_rows),]
   print(head(data1))
    data})
 }else{
   shinyjs::enable('Show')
 output$tab = renderTable({
     data = data[(1:num_rows),]
     data}) }

 })
})

shinyApp(ui, server)