Clear Plotly Click Event

Clear plotly click event

I have same problem, and the workaround I've found is to store the old state in a global variable, and do the updates only when that variable changes and not on the !is.null()

selected_date <- 0 # declare outside the server function

server <- function(input, output, session) {
  observe({
    d <- event_data("plotly_click")
    new_value <- ifelse(is.null(d),"0",d$x) # 0 if no selection
    if(selected_date!=new_value) {
      selected_date <<- new_value 
      if(selected_date !=0 && input$navPanel == 'overview')
        updateDateInput(session, "date", value = lubridate::ymd(selected_date))
    }
  })
...
}

This also allows you to add a behaviour whenever the element is unselected

Removing plotly click event data

In your example, e is just defined in the renderPrint and in the observeEvent and not globally so even if e is changed in the observeEvent, it does not trigger anything in the renderPrint.

You can use reactiveValues for this:

data <- reactiveValues(e=NULL)

  observe({
    data$e <- event_data("plotly_click")
  })

  output$plotVal <- renderPrint({
    e <- data$e
    if (is.null(e)) {
      NULL
    } else {
      e
    }
  })

  observeEvent(input[["clearEvent"]], {
    data$e <- NULL
  })

data$e is changed whenever the user click the plot or the button, and since there is a dependency on data$e in the renderPrint, that gets updated whenever data$e is changed.

Clear event_data from plotly select after processing it

Please check the following:

library(shiny)
library(plotly)
library(data.table)

testDF <- data.table(MeanDecreaseAccuracy =  runif(10, min = 0, max = 1), Variables = letters[1:10], Selected = TRUE)
setorder(testDF, MeanDecreaseAccuracy)

ui <- fluidPage(
  plotlyOutput('RFAcc_FP1',  width = 450)
)

server <- function(input, output, session) {

  RFImp_score <- reactive({
    eventData <- event_data("plotly_selected", source = 'RFAcc_FP1_source', session)
    parsToChange <- eventData$y
    testDF[Variables %in% parsToChange, Selected := !Selected]
    testDF
  })

  output$RFAcc_FP1 <- renderPlotly({
    req(RFImp_score())
    plotheight <- length(RFImp_score()$Variables) * 80

    colors <- if (length(unique(RFImp_score()$Selected)) > 1) {
      c('#F0F0F0', '#1b73c1')
    } else {
      if (unique(RFImp_score()$Selected)) {
        '#1b73c1'
      } else {
        '#F0F0F0'
      }
    }

    symbols <-
      if (length(unique(RFImp_score()$Selected)) > 1) {
        c('x', 'circle')
      } else {
        if (unique(RFImp_score()$Selected)) {
          'circle'
        } else {
          'x'
        }
      }

    p <- plot_ly(data = RFImp_score(),
                 source = 'RFAcc_FP1_source',
                 height = plotheight,
                 width = 450) %>%
      add_trace(x = ~MeanDecreaseAccuracy,
                y = ~Variables,
                type = 'scatter',
                mode = 'markers',
                color = ~factor(Selected),
                colors = colors,
                symbol = ~factor(Selected),
                symbols = symbols,
                marker = list(size  = 6),
                hoverinfo = "text",
                text = ~paste('<br>', 'Parameter: ', ~Variables,
                              '<br>',  'Mean decrease accuracy: ', format(round(MeanDecreaseAccuracy*100, digits = 2), nsmall = 2),'%',
                              sep = '')) %>%
      layout(
        margin = list(l = 160, r= 20, b = 70, t = 50),
        hoverlabel = list(font=list( color = '#1b73c1'), bgcolor='#f7fbff'),
        xaxis =  list(title = 'Mean decrease accuracy index (%)',
                      tickformat = "%",
                      showgrid = F,
                      showline = T,
                      zeroline = F,
                      nticks = 5,
                      font = list(size = 8),
                      ticks = "outside",
                      ticklen = 5,
                      tickwidth = 2,
                      tickcolor = toRGB("black")
        ),
        yaxis =  list(categoryarray = ~Variables,
                      autorange = T,
                      showgrid = F,
                      showline = T,
                      autotick = T,
                      font = list(size = 8),
                      ticks = "outside",
                      ticklen = 5,
                      tickwidth = 2,
                      tickcolor = toRGB("black")
        ),
        dragmode =  "select"
      ) %>%  add_annotations(x = 0.5,
                             y = 1.05,
                             textangle = 0,
                             font = list(size = 14,
                                         color = 'black'),
                             text = "Contribution to accuracy",
                             showarrow = F,
                             xref='paper',
                             yref='paper')

    p <- p %>% config(displayModeBar = F)
    p
  })

}
shinyApp(ui, server)

---

Result:

Select and store values of plotly click event and then use them after pressing actionButton()

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)

Reset event_data using shinyjs doesn't seem to work anymore, after the recent update

Seems like .clientValue- is not necessary anymore. Probably a change in plotly, but I am not sure about it.

Change .clientValue-plotly_click-plot to plotly_click-plot and it should work.

Output:

Exclude data points by click in plotly in a shiny app r

Nice trick with event_data there! I think all that's needing done differently is to make myData$df a named reactiveValue (with one small correction to p2$points lower down). This works for me now:

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

n   <- 20
x   <- 1:n 
y   <- cumsum(rnorm(n))
z   <- runif(n,10,200)
cat <- sample(letters[1:5],n,replace = TRUE)
delete <- FALSE

df<-data.frame(cat,x,y,z, delete)

ui <- fluidPage(
  
  selectInput("var","var", c("y","z"), "y"),
  mainPanel(plotlyOutput("plot")),
  verbatimTextOutput("selection"),
  actionButton("delete","Delete", style = "display:inline-block;"),
  actionButton("reset","Reset", style = "display:inline-block;"),
  
  
)

server <- function(input, output, session) {
  
  myData <- reactiveValues(df = df)
  
  output$plot <- renderPlotly({
    
    plot_ly(myData$df, 
            x = ~x,
            y = ~get(input$var), 
            type = "scatter", 
            mode = "markers",
            text = ~cat,
            marker = list(size = 10),
            source = "A")
    
    
  })
  
  p1 <- reactive({
    
    event_data("plotly_click", source = "A")
    
  })
  
  p2 <- reactiveValues(points = c())
  
  observeEvent(p1(),{
    
    p2$points <- c(p2$points,as.list(p1())$pointNumber)
    
  })
  
  observeEvent(input$reset,{
    
    p2$points <- c()
    
  })
  
  output$selection <- renderPrint({ if(length(p2$points+1)<1){"Select data points to delete"}else{(p2$points+1)} })
  
  
  observeEvent(input$delete,{
    # browser()
    myData$df <- myData$df %>%
      mutate(delete = ifelse(row_number() %in% c(p2$points+1),TRUE,delete)) %>%
      filter(!delete)
    
    # And clear input?
    p2$points <- c()
  })
  
  
}

shinyApp(ui, server)

---

Related Topics