Highcharter: Keep the selected Zoom when updating a stock plot

Question

I'm developing a Shiny app that allows users to update a highcharter plot with a selectInput. I want that if a user selects a range button (e.g. 6m) and then changes to another plot with the selectInput, it keeps the Zoom button selected to 6m instead of restoring it to All.

I read this answer that implements afterSetExtremes() to update the range selector at the bottom of the plot but I want to update specifically the buttons at the top so the user can see that a zoom is applied.

Below is a simple example:

library(shiny)
library(highcharter)
library(quantmod)

ui <- fluidPage(sidebarLayout(sidebarPanel(
      selectInput("selector", "Select stock",
          choices = c("GOOG", "AAPL"))
),
mainPanel(highchartOutput("plot"))))

server <- function(input, output, session) {
   output$plot <- renderHighchart({
      data <- getSymbols(input$selector, auto.assign = FALSE)
      highchart(type = 'stock') %>%
          hc_add_series(data)
   })
}

shinyApp(ui, server)

Thanks for any pointers.

Answer 1

I found an answer for my question. I took the idea from this highchart forum (the eighth post) and its jsfiddle answer. I take the value from the selected button in javascript and send it back to shiny to use it when the plot is updated.

I share the solution in case someone needs it in the future.

library(shiny)
library(highcharter)
library(quantmod)

ui <- fluidPage(sidebarLayout(sidebarPanel(
  selectInput("selector", "Select stock",
              choices = c("GOOG", "AAPL"))
),
mainPanel(highchartOutput("plot"))))

server <- function(input, output, session) {
  text_to_val <- list(
    "1m" = 0,
    "3m" = 1,
    "6m" = 2,
    "YTD" = 3,
    "1y" = 4,
    "All" = 5
  )

  PRESELECTED_TEXT <- "All"

  observeEvent(input$persistanceValue, {
    PRESELECTED_TEXT <<- input$persistanceValue
  })

  output$plot <- renderHighchart({
    data <- getSymbols(input$selector, auto.assign = FALSE)
    highchart(type = 'stock') %>%
      hc_add_series(data) %>%
      hc_xAxis(events = list(
        afterSetExtremes = JS(
          "function(e) {
          Shiny.setInputValue('persistanceValue', e.rangeSelectorButton.text);
        }"
        )
      )) %>%
      hc_rangeSelector(selected = text_to_val[[PRESELECTED_TEXT]])
  })
}

shinyApp(ui, server)