Add action buttons to update graph from multiple inputs

I have multiple select inputs that will update a graph based on what the user selects. It currently updates automatically but I want to add an apply button to each of the inputs but not totally sure how to get the action button into the server side.

UI:

ui <- dashboardPage(
  dashboardHeader(title = "Human Trafficking"),
  
  dashboardSidebar(
    sidebarMenu(
      selectInput("Source", "Choose a Data Source: ", choices = sort(unique(newNgo$Data.Source)), selected = NULL,
                  multiple = TRUE, selectize = TRUE, width = NULL, size = NULL),
      dateInput("startdate", "Start Date:", value = "2009-01-01", format = "dd-mm-yyyy",
                min = "2009-01-01", max = "2019-08-26"),
      
      dateInput("enddate", "End Date:", value = "2019-08-27", format = "dd-mm-yyyy",
                min = "2009-01-02", max = "2019-08-27"),
      selectInput("Nationality", "Select a nation: ", choices = " "),
      actionButton("button1", "Apply")
    )
  ),
  
  dashboardBody(
    
    fluidRow(
      box(width = 4, solidHeader = TRUE,
          selectInput("traffickingType", "Choose a trafficking type: ", choices = sort(unique(newNgo$Trafficking.Type)), selected = NULL,
                      multiple = TRUE, selectize = TRUE, width = NULL, size = NULL),
          actionButton("button2", "Apply")
      ),
      box(width = 4, solidHeader = TRUE,
          selectInput("traffickingSubType", "Choose a trafficking sub type: ", choices = sort(unique(newNgo$Trafficking.Sub.Type)), selected = NULL,
                      multiple = TRUE, selectize = TRUE, width = NULL, size = NULL),
          actionButton("button3", "Apply")
      ),
      box(width = 4, solidHeader = TRUE,
          selectInput("gender", "Choose a gender: ", choices = sort(unique(newNgo$Victim.Gender)), selected = NULL,
                      multiple = TRUE, selectize = TRUE, width = NULL, size = NULL),
          actionButton("button4", "Apply")
      )
    )
)

Server:

server <- function(input, output, session) {
  
  output$coolplot <- renderPlotly({
    req(c(input$gender, input$traffickingType, input$traffickingSubType))
    
    if(!is.null(input$Nationality)) {
      newNgo <- newNgo %>% filter(Victim.Nationality %in% input$Nationality)
    }
    if(!is.null(input$gender)) {
      newNgo <- newNgo %>% filter(Victim.Gender %in% input$gender)
    }
    if(!is.null(input$traffickingType)) {
      newNgo <- newNgo %>% filter(Trafficking.Type %in% input$traffickingType)
    }
    if(!is.null(input$traffickingSubType)) {
      newNgo <- newNgo %>% filter(Trafficking.Sub.Type %in% input$traffickingSubType)
    }
    if(!is.null(input$Source)) {
      newNgo <- newNgo %>% filter(Data.Source %in% input$Source)
    }
    
    plot_ly(newNgo, labels = ~Trafficking.Type, type = "pie") %>%
      layout(showlegend = FALSE)
  })
)

Not sure if the action buttons should be separate or included within the code for the graph.

If you want to update the same plot with different action buttons, you need to use observeEvent function with eventExpr argument that add up all action buttons that you want to trigger the update.

server <- function(input, output, session) {
  
  observeEvent({input$button1 + input$button2 + input$button3 + input$button4},
               {
                 req(input$gender, input$traffickingType, input$traffickingSubType)
                 
                 if(!is.null(input$Nationality)) {
                   newNgo <- newNgo %>% filter(Victim.Nationality %in% input$Nationality)
                 }
                 if(!is.null(input$gender)) {
                   newNgo <- newNgo %>% filter(Victim.Gender %in% input$gender)
                 }
                 if(!is.null(input$traffickingType)) {
                   newNgo <- newNgo %>% filter(Trafficking.Type %in% input$traffickingType)
                 }
                 if(!is.null(input$traffickingSubType)) {
                   newNgo <- newNgo %>% filter(Trafficking.Sub.Type %in% input$traffickingSubType)
                 }
                 if(!is.null(input$Source)) {
                   newNgo <- newNgo %>% filter(Data.Source %in% input$Source)
                 }
                 
                 output$coolplot <- renderPlotly(
                   {
                     plot_ly(newNgo, labels = ~Trafficking.Type, type = "pie") %>%
                       layout(showlegend = FALSE)
                   }
                 )
               })
}

Thanks for the help! At the minute when I try that code it needs all 4 action buttons to be triggered to update the graph is there a way so that if the user doesn't want to use an input they can still update the graph without needing all inputs?

If I don't get wrong that you mean the actionButton cannot update the plot without selecting all selectInputs . If yes, it is because the selectInputs have null values and stop by

req(input$gender, input$traffickingType, input$traffickingSubType)

So, try to remove this script.

Thanks for the help!! works perfectly now!

I think it's a little cleaner to use list(input$button1, input$button2, input$button3, input$button4) since that will work for any reactive input, not just buttons.

2 Likes

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.