R Highcharter: динамические сюжетные линии в Shiny - PullRequest
Новая
       47

R Highcharter: динамические сюжетные линии в Shiny

0 голосов
/ 29 января 2019

Можно ли добавить / удалить линию графика на существующей диаграмме высокого уровня без полного перерисовывания диаграммы?

Код, приведенный ниже, изменен из демоверсии highcharter с добавлениемфлажок, управляющий внешним видом линии графика.

При нажатии на флажок линия добавляется / удаляется, однако вся диаграмма перерисовывается.Было бы хорошо, чтобы была добавлена ​​/ удалена только линия без перерисовки диаграммы. 

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)

1 Ответ

0 голосов
/ 30 января 2019

Вы можете добавить событие нажатия на элемент флажка в событии загрузки диаграммы, используя метод 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)

К сожалению, я не знаю, почему событие работает с вводимым текстом только при первом нажатии.Вы можете нажать только ввод (не текст).

...