使用Shiny中的動態高圖表返回數據

Question

我在Shiny中實現了一個圖表，用戶可以使用http://jkunst.com/highcharter/oldindex.html#draggable-points示例中的「可拖動點」選項創建自己的時間序列。我想使用server.r中的「新」數據點並將它們顯示在一個表中。如果有人能夠幫助我如何返回數據點，那就太好了。請查找下面的代碼。

謝謝，TIM

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使用下拉事件（JS代碼）。
• 在前面的代碼事件中，使用Shiny.onInputChange（'inputname'，data）。這告訴閃亮的是，手動預覽數據已經改變，所以你可以在渲染函數中使用。
• 然後創建一個renderObject（renderTable）調用input $ inputname。所以你可以得到更新的數據並做你想做的任何事情。代碼

重點線

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