使用 highcharter 通过 Shiny 返回多个数据

Question

我想创建一个带有可拖动点的多折线图，并将各个点的数据返回到 Shiny 服务器的数据表中。我不知道如何编码。有没有办法将 myZax 折线图的更改返回到数据表 m_data？

server.R 代码

library(shiny)
library(highcharter)
library(data.table)


myData <- data.table(x=2012:2016, data.frame(myYax = c(3900,  4200,  5700,  8500, 11900), myZax=c(3900,  4200,  500,  800, 1000)))

shinyServer(function(input, output) {

  #Make a copy of the data table. It will be run only once when use opens the application
  m_data <- myData

  output$text1 <- renderText({ 
    paste("You have selected ",input$xaxis_name)
  })

  output$text2 <- renderText({ 
    paste("You have selected ",input$yaxis_name)
  })

  output$view <- renderTable({                      
                      m_data[x==input$xaxis_name]$myYax = input$yaxis_name                      
                      m_data})

  output$hcontainer <- renderHighchart({    
    hc <- highchart() %>% 
      hc_chart(type = "line", animation=FALSE) %>% 
      hc_title(text = "A simple demo") %>% 
      hc_subtitle(text = "A subtitle") %>% 
      hc_xAxis(categories = m_data$x) %>% 
      hc_plotOptions(
        series = list(
          point = list(
            events = list(
              drop = JS("function(){
                        Shiny.onInputChange('xaxis_name', this.category)
                        Shiny.onInputChange('yaxis_name', this.y)          
                        }")))
          ,stickyTracking = FALSE
          ),
        column = list(
          stacking = "normal"
        ),
        line = list(
          cursor = "ns-resize"
        )) %>%
      hc_add_series(       
        data = m_data$myYax , name = "Downloads",draggableY = TRUE
      ) %>%
      hc_add_series(       
        data = m_data$myZax , name = "Downloads",draggableY = TRUE
      ) 
    hc    
  })
})

ui.R

    library(shiny)

shinyUI(
  fluidPage(
            titlePanel("High Charter plotting"),  
            highchartOutput("hcontainer",height = "500px"),
            textOutput("text1"),
            textOutput("text2"),
            tableOutput("view")            
           )
)

Answer 1

不确定如果我 100% 理解您的问题会怎样。但我想提出一些建议，希望对您的问题有所帮助。

1. 代替发送 2 Shiny.onInputChange 您可以发送一个 javascript 对象，该对象像列表一样返回到 R：

   Shiny.onInputChange('hcinput', { id: this.series.name, x: this.category, y: this.y })
   

   这让代码和闪亮的服务器更加清晰。

2. 因此，在output$view 中，您可以执行以下操作：

   output$view <- renderTable({
     colname <- ifelse(input$hcinput$id == "Downloads1", "myYax", "myZax")
     m_data[x==input$hcinput$x][[colname]] = input$hcinput$y                      
     m_data
   })
   

如果你解决了你的问题，让我们讨论一下。

感谢测试包！