1

In the shiny app below I use plotly_click_event on one of the 3 linecharts to pick a point and then subset the other 2 linecharts based on that point. Then I reset using the RESET button. What I would like to improve is to be able to pick more than one points and then decide when to subset after pressing another actionButton() called SUBSET.

library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)
library(ggplot2)
library(bupaR)

pr59<-structure(list(case_id = c("WC4120721", "WC4120667", "WC4120689", 
                                 "WC4121068", "WC4120667", "WC4120666", "WC4120667", "WC4121068", 
                                 "WC4120667", "WC4121068"), lifecycle = c(110, 110, 110, 110, 
                                                                          120, 110, 130, 120, 10, 130), action = c("WC4120721-CN354877", 
                                                                                                                   "WC4120667-CN354878", "WC4120689-CN356752", "WC4121068-CN301950", 
                                                                                                                   "WC4120667-CSW310", "WC4120666-CN354878", "WC4120667-CSW308", 
                                                                                                                   "WC4121068-CSW303", "WC4120667-CSW309", "WC4121068-CSW308"), 
                     activity = c("Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)", 
                                  "Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)", 
                                  "BBH-1&2", "Forged Wire, Medium (Sport)", "TCE Cleaning", 
                                  "SOLO Oil", "Tempering", "TCE Cleaning"), resource = c("3419", 
                                                                                         "3216", "3409", "3201", "C3-100", "3216", "C3-080", "C3-030", 
                                                                                         "C3-090", "C3-080"), timestamp = structure(c(1606964400, 
                                                                                                                                      1607115480, 1607435760, 1607568120, 1607630220, 1607670780, 
                                                                                                                                      1607685420, 1607710800, 1607729520, 1607744100), tzone = "", class = c("POSIXct", 
                                                                                                                                                                                                             "POSIXt")), .order = 1:10), row.names = c(NA, -10L), class = c("eventlog", 
                                                                                                                                                                                                                                                                            "log", "tbl_df", "tbl", "data.frame"), spec = structure(list(
                                                                                                                                                                                                                                                                              cols = list(case_id = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                "collector")), lifecycle = structure(list(), class = c("collector_double", 
                                                                                                                                                                                                                                                                                                                                                                                       "collector")), action = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                                                                                                                           "collector")), activity = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 "collector")), resource = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       "collector")), timestamp = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              "collector"))), default = structure(list(), class = c("collector_guess", 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    "collector")), delim = ";"), class = "col_spec"), case_id = "case_id", activity_id = "activity", activity_instance_id = "action", lifecycle_id = "lifecycle", resource_id = "resource", timestamp = "timestamp")
ui <- tags$body(
  dashboardPage(
    header = dashboardHeader(), 
    sidebar = dashboardSidebar(
      actionButton("sub","SUBSET"),
      actionButton("res","RESET")
      
      
      
    ), 
    body = dashboardBody(
      plotlyOutput("plot1"),
      plotlyOutput("plot2"),
      plotlyOutput("plot3")
    )
  )
)

server <- function(input, output, session) {
  output$plot1 <- renderPlotly({
    if (!is.null(myPlotEventData2())) {
      displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData2()$customdata))
    } else if (!is.null(myPlotEventData3())){
      displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData3()$customdata))
    } else {
      displaydat <- pr59
    }
    dat <- displaydat |> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
    p <- ggplot(data = dat, aes(x = date, y = n_cases, customdata = date)) +
      geom_area(fill = "#69b3a2", alpha = 0.4) +
      geom_line(color = "#69b3a2", size = 0.5) +
      geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
      labs(title = "Cases per month", x = "timestamp", y = "Cases")
    ggplotly(p, source = "myPlotSource1")
    
  })
  
  output$plot2 <- renderPlotly({
    if (!is.null(myPlotEventData1())) {
      displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData1()$customdata))
    } else if (!is.null(myPlotEventData3())){
      displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData3()$customdata))
    } else {
      displaydat <- pr59
    }
    dat <- displaydat|> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
    
    p <- ggplot(data = dat, aes(x = date, y = n_cases, customdata = date)) +
      geom_area(fill = "#69b3a2", alpha = 0.4) +
      geom_line(color = "#69b3a2", size = 0.5) +
      geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
      labs(title = "Cases per month", x = "timestamp", y = "events")
    ggplotly(p, source = "myPlotSource2")
    
  })
  
  output$plot3 <- renderPlotly({
    if (!is.null(myPlotEventData1())) {
      displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData1()$customdata))
    } else if (!is.null(myPlotEventData2())){
      displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData2()$customdata))
    } else {
      displaydat <- pr59
    }
    dat <- displaydat |> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
    
    p <- ggplot(data = dat, aes(x =date, y = n_cases, customdata = date)) +
      geom_area(fill = "#69b3a2", alpha = 0.4) +
      geom_line(color = "#69b3a2", size = 0.5) +
      geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
      labs(title = "Cases per month", x = "timestamp", y = "objects")
    ggplotly(p, source = "myPlotSource3")
  })
  
  myPlotEventData1 <- reactiveVal()
  myPlotEventData2 <- reactiveVal()
  myPlotEventData3 <- reactiveVal()
  
  observe({
    myPlotEventData1(event_data(event = "plotly_click", source = "myPlotSource1"))
  })
  
  observe({
    myPlotEventData2(event_data(event = "plotly_click", source = "myPlotSource2"))
  })
  
  observe({
    myPlotEventData3(event_data(event = "plotly_click", source = "myPlotSource3"))
  })
  
  observeEvent(input$res, {
    myPlotEventData1(NULL)
    myPlotEventData2(NULL)
    myPlotEventData3(NULL)
  })
}

shinyApp(ui, server)
firmo23
  • 7,490
  • 2
  • 38
  • 114
  • I don't know about a feature that would let you do this : You can change your code to store each clicked value in a vector, use it for subsetting when Subset button is clicked. Reset the vector on Reset button. – HubertL Nov 24 '22 at 02:08
  • @HubertL we could use `plotly_selected` along with the "Box" or "Lasso Select" instead of `plotly_click`. Please check my related answer [here](https://stackoverflow.com/a/74531454/9841389). – ismirsehregal Nov 24 '22 at 08:33
  • this would be nice but still remains the issue of the latest plotly version I guess – firmo23 Nov 24 '22 at 13:15

1 Answers1

2

Your example is by far not minimal, so I created a POC of how this can be achieved.

The idea is as follows:

  1. On each click you add the data to a reactiveValues list.
  2. On a click to subset you use this list to select the relevant points.
  3. A click to reset resets this reactiveList and all data is returned.

As it was not clear how clicks on different graphs should be handled, I decided on the follwoing logic: a click to a point in any graph panel adds this point to the filter criterion. Upon subset all data are subset w.r.t. to this filter criterion.

library(shiny)
library(dplyr)
library(plotly)

## sample data
sample_dat <- expand.grid(
  when = seq.Date(as.Date("2022-1-1"), as.Date("2022-1-31"), by = "days"),
  grp = factor(paste("Group", 1:3))
) %>% 
  as_tibble() %>% 
  mutate(y = scales::rescale((9496.5 - as.numeric(when)), c(-2, 2)) ^ 
                as.numeric(grp)) 

make_plotly <- function(dat, wh = levels(dat$grp)) {
  wh <- match.arg(wh)
  dat %>% 
    filter(grp == wh) %>%
    plot_ly(source = sub(" ", "_", wh)) %>%
    add_trace(x = ~ when, y = ~ y, type = "scatter", mode = "lines+markers")
}

grph_ht <- "300px"

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      actionButton("reset", "RESET"),
      actionButton("subset", "SUBSET"),
      verbatimTextOutput("dbg")      
    ),
    mainPanel(
      plotlyOutput("plot1", height = grph_ht),
      plotlyOutput("plot2", height = grph_ht),
      plotlyOutput("plot3", height = grph_ht)
    )
  )
)

server <- function(input, output, session) {
  get_clicked_points <- reactive({
    res <- Reduce(rbind, reactiveValuesToList(clicked_points))
    if (!is.null(res)) {
      res %>% 
        distinct()
    } else {
      res
    }
  })
  
  get_rel_data <- reactive({
    clicked_pts <- get_clicked_points()
    dat <- sample_dat
    if (!is.null(clicked_pts)) {
      dat <- dat %>% 
        inner_join(clicked_pts %>% 
                     transmute(when = as.Date(x)),
                   "when")
    }
    dat
  })
  
  ## store clicked points in reactive
  clicked_points <- reactiveValues(Group_1 = NULL,
                                   Group_2 = NULL,
                                   Group_3 = NULL)
  
  trigger_regraph <- reactive({
    list(input$reset, input$subset)
  })
  
  ## In this loop we create the render functions and the click observers
  for (idx in 1:3) {
    local({
      idx <- idx
      
      ## Render plotly
      output[[paste0("plot", idx)]] <<- renderPlotly({
        trigger_regraph()
        make_plotly(isolate(get_rel_data()), paste("Group", idx))
      })
      
      ## Click handler
      nm <- paste0("Group_", idx)
      observe({
        trg <- event_data("plotly_click", nm, priority = "event") %>% 
          req() %>% 
          mutate(src = nm)
        op <- isolate(clicked_points[[nm]])
        clicked_points[[nm]] <<- rbind(op, trg) %>%
          distinct() 
      })
    })
  }
  
  
  ## clear selected points
  observeEvent(input$reset, {
    nms <- names(clicked_points)
    for (nm in nms) {
      local({
        nm <- nm
        clicked_points[[nm]] <<- NULL
      })
    }
  })
  
  
  output$dbg <- renderPrint(get_clicked_points())
}

shinyApp(ui, server)
thothal
  • 16,690
  • 3
  • 36
  • 71