R shiny highchart retain color of clicked points after data update

Viewed 49

I built an R shiny + highchart scatterplot in which data updates across years are animated. In the dummy version below, you can see that the two points wander from left to right when starting the animation.

Since the real plot contains many more points, I want users to be able to click on points of interest, which then change their color, so that users can track changes more easily.

I managed that the points change their color to red when clicking on them. However, when starting the animation, the clicked points lose their coloring again since the data is continuously updated.

I am wondering how to retain the coloring in each update.

library(shiny)
library(highcharter)
library(dplyr)

dat <- 
  data.frame(
    year=seq(2000,2020),
    x=seq(0,20),
    y=seq(0,20),
    name=letters[seq(1,21)]
  ) %>% 
  add_row(
    data.frame(
      year=seq(2000,2020),
      x=seq(2,22),
      y=seq(2,22),
      name=letters[seq(1,21)]
    ) )

shinyApp(
  
  ui=fluidPage(
    
    # Slider ------------------------------------------------------------------------------------- #
    sliderInput(
      inputId = "g2_slider",
      label = NULL,
      min = 2000,
      max = 2020,
      value = 2000,
      step = 1,
      sep = "",
      animate = animationOptions(
        interval = 1000,
        loop = FALSE,
        playButton = actionButton("play", "Play", icon = icon("play"), width = "100px", style = "margin-top: 10px"),
        pauseButton = actionButton("pause", "Pause", icon = icon("pause"), width = "100px", style = "margin-top: 10px")
      )),
    
    actionButton("reset", "Reset", width = "100px", style = "margin-top: -87px"),
    
    # Scatterplot -------------------------------------------------------------------------------- #
    
    highchartOutput("g2_plot"),
    
  ), 
  
  server=function(input, output, session) {
    
    x_min <- dat %>% pull(x) %>% min()
    x_max <- dat %>% pull(x) %>% max()
    y_min <- dat %>% pull(y) %>% min()
    y_max <- dat %>% pull(y) %>% max()
    
    # Reset button ------------------------------------------------------------------------------- #
    
    observeEvent(input$reset, {
      updateSliderInput(
        session = session,
        inputId = "g2_slider",
        value = 2000
      )
    })
    
    # Scatterplot -------------------------------------------------------------------------------- #
    
    output$g2_plot <- renderHighchart({ 
      
      highchart() %>% 
        hc_add_series(
          data = dat %>% filter(year==input$g2_slider),
          type = "scatter",
          animation=FALSE,
          mapping = 
            hcaes(
              x=x,
              y=y,
              name=name
            ),
          id="scatter1"
        ) %>% 
        hc_plotOptions(
          series = list(
            point = list(
              events = list(
                click = JS("function(event) { this.update({color: 'red'}) }") 
              )))) %>% 
        hc_title(text = paste0("Year: ", input$g2_slider)) %>% 
        hc_xAxis(
          title = list(text = "x"),
          min=x_min, 
          max=x_max
        ) %>%
        hc_yAxis(
          title = list(text = "y"),
          min=y_min,
          max=y_max
        ) %>%
        hc_legend(enabled = FALSE) 
    })
    
    # Update scatterplot ------------------------------------------------------------------------- #
    
    observeEvent(input$g2_slider, {
      
      highchartProxy("g2_plot") %>%
        hcpxy_update_series(
          id = "scatter1",
          data = dat %>% filter(year==input$g2_slider),
          mapping = hcaes(
            x=x,
            y=y,
            name=name
          )) %>% 
        hcpxy_update(title = list(text = paste0("Year: ", input$g2_slider)))
      
    })
    
  })
1 Answers

@magdalena solved the problem. By giving each data point an id, the color is retained in updates.

dat <- 
  data.frame(
    year=seq(2000,2020),
    id=1,
    x=seq(0,20),
    y=seq(0,20),
    name=letters[seq(1,21)]
  ) %>% 
  add_row(
    data.frame(
      year=seq(2000,2020),
      id=2,
      x=seq(2,22),
      y=seq(2,22),
      name=letters[seq(1,21)]
    ) )


shinyApp(
  
  ui=fluidPage(
    
    # Slider -------------------------------- #
    sliderInput(
      inputId = "g2_slider",
      label = NULL,
      min = 2000,
      max = 2020,
      value = 2000,
      step = 1,
      sep = "",
      animate = animationOptions(
        interval = 1000,
        loop = FALSE,
        playButton = actionButton("play", "Play", icon = icon("play"), width = "100px", style = "margin-top: 10px"),
        pauseButton = actionButton("pause", "Pause", icon = icon("pause"), width = "100px", style = "margin-top: 10px")
      )),
    
    actionButton("reset", "Reset", width = "100px", style = "margin-top: -87px"),
    
    # Scatterplot ---------------------------- #
    
    highchartOutput("g2_plot"),
    
  ), 
  
  server=function(input, output, session) {
    
    x_min <- dat %>% pull(x) %>% min()
    x_max <- dat %>% pull(x) %>% max()
    y_min <- dat %>% pull(y) %>% min()
    y_max <- dat %>% pull(y) %>% max()
    
    # Reset button --------------------------- #
    
    observeEvent(input$reset, {
      updateSliderInput(
        session = session,
        inputId = "g2_slider",
        value = 2000
      )
    })
    
    # Scatterplot ---------------------------- #
    
    output$g2_plot <- renderHighchart({ 
      
      isolate({
        
        highchart() %>% 
          hc_add_series(
            data = dat %>% filter(year==input$g2_slider),
            type = "scatter",
            animation=FALSE,
            mapping = 
              hcaes(
                id=id,
                x=x,
                y=y
              ),
            id="scatter1"
          ) %>% 
          hc_plotOptions(
            series = list(
              type="scatter", 
              data=dat %>% filter(year==input$g2_slider),
              point = list(
                events = list(
                  click = JS("function(event) { this.update({color: 'red'}) }") 
                )))) %>% 
          hc_title(text = paste0("Year: ", input$g2_slider)) %>% 
          hc_xAxis(
            title = list(text = "x"),
            min=x_min, 
            max=x_max
          ) %>%
          hc_yAxis(
            title = list(text = "y"),
            min=y_min,
            max=y_max
          ) %>%
          hc_legend(enabled = FALSE) 
        
      })
      
    })
    
    # Update scatterplot --------------------- #
    
    observeEvent(input$g2_slider, {
      
      highchartProxy("g2_plot") %>%
        hcpxy_set_data(
          type = "scatter",
          data = dat %>% filter(year==input$g2_slider),
          mapping = 
            hcaes(
              id=id,
              x=x,
              y=y
            )
        ) %>% 
        hcpxy_update(title = list(text = paste0("Year: ", input$g2_slider)))
      
    })
    
  })
Related