Change Plotly highlight with Buttons

Question

I am plotting a timeseries with Plotly and by clicking on a certain column/day, some special event occurs. Now I also want to use navigation buttons (next / previous day), which change the selected day.

The problem is that the highlighting remains on the column that was clicked in the plot and therefore will differ from the actual selected day when clicking the navigation buttons.

How can I change the highlighting of Plotly with actionButtons?

or

How can I simulate a click on a Plotly-column with actionButons?

Test-App:

## Libs##########
library(shiny)
library(ggplot2)
library(plotly)
library(data.table)

## Data ############
dfN <- data.table(
  time_stamp = seq.Date(as.Date("2018-04-01"), as.Date("2018-07-30"), 1),
  val = runif(121, 100,1000),
  qual = 8,
  col = "green", stringsAsFactors = F
)
setkey(dfN, time_stamp)

Rnd <- sample(1:nrow(dfN), size = 10, replace = F)
dfN[Rnd,"col"] <- "red"
dfN[Rnd, "qual"] <- 3

## Ui ##########
ui <- fluidPage(
  plotlyOutput("plot"),
  h4("Which Day is selected:"),
  verbatimTextOutput("selected"),
  actionButton("prev1", "Previous Element"),
  actionButton("next1", "Next Element")
)

## Server ##########
server <- function(input, output, session) {
  ## Plot
  output$plot <- renderPlotly({
    key <- highlight_key(dfN)
    p <- ggplot() +
      geom_col(data = key, aes(x = plotly:::to_milliseconds(time_stamp), y = val, fill=I(col),
                               text=paste("Date: ", time_stamp, "<br>",
                                          "Quality: ", qual))) +
      labs(y = "", x="") +
      theme(legend.position="none")

    ggplotly(p, source = "Src", tooltip = "text") %>% 
      layout(xaxis = list(tickval = NULL, ticktext = NULL, type = "date")) %>% 
      highlight(selectize=F, off = "plotly_doubleclick", on = "plotly_click", color = "blue",
                opacityDim = 0.5, selected = attrs_selected(opacity = 1))
  })

  ## Selected Day reactive
  SelectedDay <- reactiveVal(NULL)

  ## Plotly Event for clicks
  observe({
    s <- event_data("plotly_click", source = "Src")
    req(s)
    SelectedDay(as.Date(s$x))
  })

  ## Action buttons for next / previous Day
  observeEvent(input$next1, {
    IND <- which(dfN$time_stamp == SelectedDay()) + 1
    if (IND >= length(dfN$time_stamp)) {
      IND = length(dfN$time_stamp)
      print("last element reached")
    }
    SelectedDay(dfN[IND,time_stamp])
  })
  observeEvent(input$prev1, {
    IND <- which(dfN$time_stamp == SelectedDay()) - 1
    if (IND <= 1) {
      print("first element reached")
      IND = 1
    }
    SelectedDay(dfN[IND,time_stamp])
  })

  ## Print the actual selection
  output$selected <- renderPrint({
    req(SelectedDay())
    SelectedDay()
  })
}

shinyApp(ui, server)

Answer 1

I needed to drop your ggplotly(), but nevertheless here is how I would approach this:

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

## Data ############

dfN <- data.table(
  time_stamp = seq.Date(as.Date("2018-04-01"), as.Date("2018-07-30"), 1),
  val = runif(121, 100,1000),
  qual = 8,
  col = "green", stringsAsFactors = F
)
setkey(dfN, time_stamp)

Rnd <- sample(1:nrow(dfN), size = 10, replace = F)
dfN[Rnd,"col"] <- "red"
dfN[Rnd, "qual"] <- 3

## Ui ##########
ui <- fluidPage(
  plotlyOutput("plot"),
  h4("Which Day is selected:"),
  verbatimTextOutput("selected"),
  actionButton("prev1", "Previous Element"),
  actionButton("next1", "Next Element")
)

## Server ##########
server <- function(input, output, session) {
  ## Plot
  output$plot <- renderPlotly({
    plot_ly(dfN, source = "Src", x=~time_stamp, y=~val, selectedpoints=as.list(which(dfN$time_stamp==SelectedDay())-1), type = "bar")
  })

  ## Selected Day reactive
  SelectedDay <- reactiveVal(dfN$time_stamp[1])

  ## Plotly Event for clicks
  observe({
    s <- event_data("plotly_click", source = "Src")
    req(s)
    SelectedDay(as.Date(s$x))
  })

  ## Action buttons for next / previous Day
  observeEvent(input$next1, {
    IND <- which(dfN$time_stamp == SelectedDay()) + 1
    if (IND >= length(dfN$time_stamp)) {
      IND = length(dfN$time_stamp)
      print("last element reached")
    }
    SelectedDay(dfN[IND,time_stamp])
  })
  observeEvent(input$prev1, {
    IND <- which(dfN$time_stamp == SelectedDay()) - 1
    if (IND <= 1) {
      print("first element reached")
      IND = 1
    }
    SelectedDay(dfN[IND,time_stamp])
  })

  ## Print the actual selection
  output$selected <- renderPrint({
    req(SelectedDay())
    SelectedDay()
  })
}

shinyApp(ui, server)

Maybe you can adapt it to your needs. Please also see: https://plot.ly/r/reference/#bar-selectedpoints

Multiple selectedpoints example:

library(plotly)

singleP <- plot_ly(data.frame(x=1:10, y=1:10), x=~x, y=~y, selectedpoints=list(1,8), type = "bar")

multiP <- plot_ly(data.frame(x=1:10, y=1:10)) %>% 
  add_trace(x=~x, y=~y, selectedpoints=list(1,8), type = "bar") %>% 
  add_trace(x=~x, y=~y, selectedpoints=list(0,2,6), type = "bar")

subplot(singleP, multiP)