There was no event observed after the triggers happened once

[aluxh]

I was trying to create a dashboard that allows users to filter the datatable based on click events on Gauge charts using the billboarder library. However, in my implementation, the dashboard can only observe the events on gauge only once. If I click on the same gauge, it doesn't work anymore.

The following is my sample code.

library(shiny)
library(shinydashboard)
library(billboarder)

sidebar <- dashboardSidebar(
    disable = TRUE,
    collapsed = TRUE,
    sidebarMenu(
        menuItem("Dashboard", tabName="Dashboard", icon=icon("dashboard"))
    )
)

body <- dashboardBody(
    tabItems(
        tabItem(
            tabName = "Dashboard",
            fluidRow(
                box(width = 4, title = "Box 1",
                    billboarderOutput(outputId = "box1", height = "auto")
                ),
                box(width = 4, title = "Box 2",
                    billboarderOutput(outputId = "box2", height = "auto")
                ),
                box(width = 4, title = "Box 3",
                    billboarderOutput(outputId = "box3", height = "auto")
                )
            ),
            fluidRow(
                box(width = 12, title = "output", DTOutput("car_table"))
            )
        )
    )
)

ui <- dashboardPage(
    header = dashboardHeader(), 
    sidebar = sidebar, body = body
)

server <- function(input, output) {

    observeEvent(input$box1_click$value, { car_data$data <- subset(mtcars, mpg > 15) })
    observeEvent(input$box2_click$value, { car_data$data <- subset(mtcars, mpg > 25) })
    observeEvent(input$box3_click$value, { car_data$data <- subset(mtcars, mpg > 20) })

    car_data <- reactiveValues(data = mtcars)

    output$box1 <- renderBillboarder({
        billboarder() %>% 
            bb_gaugechart(value = nrow(subset(mtcars, mpg > 15)), name = "cars") %>% 
            bb_gauge(min = 0, max = nrow(mtcars), units = "items",
                     label = list(format = htmlwidgets::JS("function(value) {return value;}")))
    })

    output$box2 <- renderBillboarder({
        billboarder() %>% 
            bb_gaugechart(value = nrow(subset(mtcars, mpg > 25)), name = "cars") %>% 
            bb_gauge(min = 0, max = nrow(mtcars), units = "items", 
                     label = list(format = htmlwidgets::JS("function(value) {return value;}")))
    })

    output$box3 <- renderBillboarder({
        billboarder() %>% 
            bb_gaugechart(value = nrow(subset(mtcars, mpg > 20)), name = "cars") %>% 
            bb_gauge(min = 0, max = nrow(mtcars), units = "items",
                     label = list(format = htmlwidgets::JS("function(value) {return value;}")))
    })

    output$car_table <- renderDT({
        DT::datatable(car_data$data)
    })

}
shinyApp(ui = ui, server = server)

[pvictor]

Hello, That's because the input value send to the server hasn't change, so the observeEvent isn't triggered. A solution is to force the value to be sent, but you have to had a onclick event yourself :

billboarder() %>%
bb_data(
 onclick = JS("function(d, element) {Shiny.setInputValue('click1', 1, {priority: 'event'});}")
)

The value will be accessible in server with ìnput$click1, and each click will trigger observe handlers server-side.

Corresponding part of your code that you'll have to change (in server) :

  observeEvent(input$click1, { car_data$data <- subset(mtcars, mpg > 15) })
  observeEvent(input$click2, { car_data$data <- subset(mtcars, mpg > 25) })
  observeEvent(input$click3, { car_data$data <- subset(mtcars, mpg > 20) })

  car_data <- reactiveValues(data = mtcars)

  output$box1 <- renderBillboarder({
    billboarder() %>% 
      bb_gaugechart(value = nrow(subset(mtcars, mpg > 15)), name = "cars") %>% 
      bb_gauge(min = 0, max = nrow(mtcars), units = "items",
               label = list(format = htmlwidgets::JS("function(value) {return value;}"))) %>% 
      bb_data(
        onclick = JS("function(d, element) {Shiny.setInputValue('click1', 1, {priority: 'event'});}")
      )
  })

  output$box2 <- renderBillboarder({
    billboarder() %>% 
      bb_gaugechart(value = nrow(subset(mtcars, mpg > 25)), name = "cars") %>% 
      bb_gauge(min = 0, max = nrow(mtcars), units = "items", 
               label = list(format = htmlwidgets::JS("function(value) {return value;}"))) %>% 
      bb_data(
        onclick = JS("function(d, element) {Shiny.setInputValue('click2', 2, {priority: 'event'});}")
      )
  })

  output$box3 <- renderBillboarder({
    billboarder() %>% 
      bb_gaugechart(value = nrow(subset(mtcars, mpg > 20)), name = "cars") %>% 
      bb_gauge(min = 0, max = nrow(mtcars), units = "items",
               label = list(format = htmlwidgets::JS("function(value) {return value;}"))) %>% 
      bb_data(
        onclick = JS("function(d, element) {Shiny.setInputValue('click3', 3, {priority: 'event'});}")
      )
  })

Note that here three new inputs are declared, but we can use the same ID for the three gauges, and different value, it will change the logic in the observe, but same effects :

  observeEvent(input$click_gauge, {
    if (input$click_gauge == 1) {
      car_data$data <- subset(mtcars, mpg > 15)
    } else if (input$click_gauge == 2) {
      car_data$data <- subset(mtcars, mpg > 25)
    } else if (input$click_gauge == 3) {
      car_data$data <- subset(mtcars, mpg > 20)
    }
  })

  car_data <- reactiveValues(data = mtcars)

  output$box1 <- renderBillboarder({
    billboarder() %>% 
      bb_gaugechart(value = nrow(subset(mtcars, mpg > 15)), name = "cars") %>% 
      bb_gauge(min = 0, max = nrow(mtcars), units = "items",
               label = list(format = htmlwidgets::JS("function(value) {return value;}"))) %>% 
      bb_data(
        onclick = JS("function(d, element) {Shiny.setInputValue('click_gauge', 1, {priority: 'event'});}")
      )
  })

  output$box2 <- renderBillboarder({
    billboarder() %>% 
      bb_gaugechart(value = nrow(subset(mtcars, mpg > 25)), name = "cars") %>% 
      bb_gauge(min = 0, max = nrow(mtcars), units = "items", 
               label = list(format = htmlwidgets::JS("function(value) {return value;}"))) %>% 
      bb_data(
        onclick = JS("function(d, element) {Shiny.setInputValue('click_gauge', 2, {priority: 'event'});}")
      )
  })

  output$box3 <- renderBillboarder({
    billboarder() %>% 
      bb_gaugechart(value = nrow(subset(mtcars, mpg > 20)), name = "cars") %>% 
      bb_gauge(min = 0, max = nrow(mtcars), units = "items",
               label = list(format = htmlwidgets::JS("function(value) {return value;}"))) %>% 
      bb_data(
        onclick = JS("function(d, element) {Shiny.setInputValue('click_gauge', 3, {priority: 'event'});}")
      )
  })

Victor

[aluxh]

It works! Thank you very much! But just wanted to make sure I understand the solution correctly. Can I assume that input$click_gauge reference to the onClick Javascript ID?

[aluxh]

Thanks @pvictor! I've implemented option 2 in my code, and it works well!