更新数据后，r亮高图保留点击点的颜色。

Question

我建立了一个R闪亮+高图表散点图，其中的数据更新跨年动画。在下面的虚拟版本中，您可以看到两个点在启动动画时从左到右徘徊。

由于真实的情节包含更多的点，我希望用户能够点击感兴趣的点，然后改变他们的颜色，这样用户就可以更容易地跟踪变化。

我设法在点击这些点时将它们的颜色更改为红色。但是，在启动动画时，由于数据不断更新，单击点再次失去颜色。

我想知道如何在每次更新中保留着色。

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

Answer 1

@magdalena解决了这个问题。通过给每个数据点一个id，在更新中保留颜色。

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