在 Shiny 中使用来自动态 highcharts 图表的返回数据

Question

我正在 Shiny 中实现一个图表，用户可以使用 http://jkunst.com/highcharter/oldindex.html#draggable-points 示例中的“可拖动点”选项创建自己的时间序列。我想使用 server.r 中的“新”数据点并将它们显示在表格中。如果有人可以帮助我如何返回数据点，那就太好了。请在下面找到代码。

谢谢，蒂姆

server.r:

data(citytemp, package = "highcharter")
   function(input, output) {
 hcbase <- reactive({
   # hcbase <- function() highchart() 
   hc <- highchart() 


   if (input$credits)
     hc <- hc %>% hc_credits(enabled = TRUE, text = "Highcharter", href =    "http://jkunst.com/highcharter/")

if (input$exporting)
  hc <- hc %>% hc_exporting(enabled = TRUE)

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

    hc <- hc %>% hc_add_theme(theme)
  }

  hc

})


 output$table <-renderDataTable({
   #Output from graph
   data.table(month=citytemp$month,berlin=citytemp$berlin
              ,berlin_dragged=citytemp$berlin)#Here I want to use the dragged data. something linke input$highchart$... should do the trick I guess...
 })

output$highchart <- renderHighchart({

data(citytemp)
highchart() %>% 
  hc_chart(animation = FALSE) %>% 
  hc_title(text = "draggable points demo") %>% 
  hc_xAxis(categories = month.abb) %>% 
  hc_plotOptions(
    series = list(

    stickyTracking = FALSE
        ),
    column = list(
      stacking = "normal"
    ),
    line = list(
      cursor = "ns-resize"
    )
    ) %>% 

  hc_add_series(
    data = citytemp$berlin,
    draggableY = TRUE
  )

})



 }
ui.r

library("shiny")
library("shinydashboard")
library("highcharter")
library("dplyr")
library("viridisLite")
library("markdown")
library("quantmod")
library("tidyr")
library("ggplot2")
library("treemap")
library("forecast")
library("DT")
rm(list = ls())

dashboardPage(
  skin = "black",
  dashboardHeader(title = "highcharter", disable = FALSE),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Examples", tabName = "examples", icon = icon("bar-chart"))
    )
    #,
    #div(includeMarkdown("hcterinfo.md"), style = "padding:10px")
  ),
  dashboardBody(
    # tags$head(tags$script(src = "js/ga.js")),
    # tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "css/custom_fixs.css")),
    tabItems(
      tabItem(tabName = "examples",
              fluidRow(

              box(width = 6, highchartOutput("highchart")),
              box(width = 6, dataTableOutput("table"))

      )
    )
  )
))

Answer 1

关键部分是：

• 在 highcharts 中使用 drop 事件（JS 代码）。
• 在前面的代码事件中使用 Shiny.onInputChange('inputname', data)。这告诉 Shiny 手动预测数据已更改，因此您可以在渲染函数中使用。
• 然后创建一个调用 input$inputname 的 renderObject (renderTable)。这样您就可以获取更新后的数据并为所欲为。

关键代码行

    hc_plotOptions(
    series = list(
      point = list(
        events = list(
          drop = JS("function(){
                    console.log(this.series)
                    window.data = _.map(this.series.data, function(e) { return e.y })
                    Shiny.onInputChange('inputname', data);
                    }"))
          )))

然后：

renderDataTable({
   ...
   var <- input$inputname # listening the drop event 
   ...

参考：https://github.com/jbkunst/shiny-apps/blob/master/highcharter/server.R#L158