R Highcharter：Shiny 中的动态情节线

Question

是否可以在不完全重绘图表的情况下向现有的高级图表添加/删除绘图线？

下面的代码是从highcharter demo 修改的，添加了一个控制绘图线外观的复选框。

单击复选框时，会添加/删除线，但会重新绘制整个图表。最好只添加/删除线条而不重绘图表。

library(shiny)
library(highcharter)

data(citytemp)

ui <- fluidPage(
  h1("Highcharter Demo"),
  fluidRow(
    column(width = 4, class = "panel",
           selectInput("type", label = "Type", width = "100%",
                       choices = c("line", "column", "bar", "spline")), 
           selectInput("stacked", label = "Stacked",  width = "100%",
                       choices = c(FALSE, "normal", "percent")),
           selectInput("theme", label = "Theme",  width = "100%",
                       choices = c(FALSE, "fivethirtyeight", "economist",
                                   "darkunica", "gridlight", "sandsignika",
                                   "null", "handdrwran", "chalk")
           ),
           checkboxInput("chk_plot_line", "Add a plot line")
    ),
    column(width = 8,
           highchartOutput("hcontainer",height = "500px")
    )
  )
)

server = function(input, output) {

  output$hcontainer <- renderHighchart({

    hc <- highcharts_demo() %>%
      hc_chart(zoomType = "x") %>%
      hc_rm_series("Berlin") %>% 
      hc_chart(type = input$type)

    if (input$stacked != FALSE) {
      hc <- hc %>%
        hc_plotOptions(series = list(stacking = input$stacked))
    }

    if(input$chk_plot_line != FALSE){
      hc <- hc %>%
        hc_xAxis(title = list(text = "With a plot line"),
                 plotLines = list(
                   list(label = list(text = "This is a plotLine"),
                        color = "#FF0000",
                        width = 2,
                        value = 5.5)
                   )
                 )
    }

    if (input$theme != FALSE) {
      theme <- switch(input$theme,
                      null = hc_theme_null(),
                      darkunica = hc_theme_darkunica(),
                      gridlight = hc_theme_gridlight(),
                      sandsignika = hc_theme_sandsignika(),
                      fivethirtyeight = hc_theme_538(),
                      economist = hc_theme_economist(),
                      chalk = hc_theme_chalk(),
                      handdrwran = hc_theme_handdrawn()
      )

      hc <- hc %>% hc_add_theme(theme)

    }

    hc

  })

}

shinyApp(ui = ui, server = server)

Answer 1

您可以使用 JS() 方法在图表加载事件中的复选框元素上添加单击事件。这里有完整的代码：

library(shiny)
library(highcharter)

data(citytemp)

ui <- fluidPage(
  h1("Highcharter Demo"),
  fluidRow(
    column(width = 4, class = "panel",
       selectInput("type", label = "Type", width = "100%",
                   choices = c("line", "column", "bar", "spline")), 
       selectInput("stacked", label = "Stacked",  width = "100%",
                   choices = c(FALSE, "normal", "percent")),
       selectInput("theme", label = "Theme",  width = "100%",
                   choices = c(FALSE, "fivethirtyeight", "economist",
                               "darkunica", "gridlight", "sandsignika",
                               "null", "handdrwran", "chalk")
       ),
       checkboxInput("chk_plot_line", "Add a plot line")
    ),
    column(width = 8,
       highchartOutput("hcontainer",height = "500px")
    )
  )
)

server = function(input, output) {

  output$hcontainer <- renderHighchart({

hc <- highcharts_demo() %>%
  hc_chart(zoomType = "x", events = list(load = JS("
    function() {
      var chart = this,
        checkbox = document.querySelector('.checkbox'),
        hasPlotLine = false;
      checkbox.addEventListener('click', function() {
        if (!hasPlotLine) {
          chart.xAxis[0].setTitle({
            text: 'With a plot line'
          });
          chart.xAxis[0].addPlotLine({
            value: 5.5,
            color: 'red',
            width: 2,
            id: 'plot-line-1'
          });
        } else {
          chart.xAxis[0].setTitle({
            text: 'Sample title'
          });
          chart.xAxis[0].removePlotLine('plot-line-1');
        }
        hasPlotLine = !hasPlotLine;
      })
    }"))) %>%
  hc_rm_series("Berlin") %>% 
  hc_chart(type = input$type)

if (input$stacked != FALSE) {
  hc <- hc %>%
    hc_plotOptions(series = list(stacking = input$stacked))
}



if (input$theme != FALSE) {
  theme <- switch(input$theme,
                  null = hc_theme_null(),
                  darkunica = hc_theme_darkunica(),
                  gridlight = hc_theme_gridlight(),
                  sandsignika = hc_theme_sandsignika(),
                  fivethirtyeight = hc_theme_538(),
                  economist = hc_theme_economist(),
                  chalk = hc_theme_chalk(),
                  handdrwran = hc_theme_handdrawn()
  )

  hc <- hc %>% hc_add_theme(theme)

}

hc

})

}

 shinyApp(ui = ui, server = server)

不幸的是，我不知道为什么该事件仅在第一次单击时才对输入文本起作用。您只能单击输入（不是文本）。