Измените выделение Plotly с помощью кнопок

Question

Я строю временные ряды с помощью Plotly и, щелкая определенный столбец / день, происходит какое-то особое событие.Теперь я также хочу использовать кнопки навигации (следующий / предыдущий день), которые изменяют выбранный день.

Проблема заключается в том, что выделение остается в столбце, который был нажат на графике, и, следовательно, будет отличаться от фактического выбранного дня при нажатии кнопок навигации.

Как изменитьвыделение Plotly с помощью actionButtons?

или

Как я могу имитировать щелчок по столбцу Plotly с помощью actionButons?

ТестПриложение:

## 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

Мне нужно было отказаться от вашего ggplotly(), но, тем не менее, вот как я бы подошел к этому:

## 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)

Возможно, вы сможете адаптировать его к вашим потребностям.См. Также: https://plot.ly/r/reference/#bar-selectedpoints

Несколько selectedpoints пример:

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)