Monday, 26 November 2018

Change Plotly highlight with Buttons

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)



from Change Plotly highlight with Buttons

No comments:

Post a Comment