在R shiny/rcharts中呈現渲染後添加highcharts plotband

我試圖在運行rCharts和shiny的應用中複製此（jsfiddle）highcharts功能。我想要一個用戶事件（改變文本框中的一個值）來將plotblot添加到已經渲染的圖中（或者理想地刪除之前的/添加一個新的）。我可以通過在xAxis選項中用plotband重繪圖來工作，但對於我繪製的一些圖而言，這可能非常慢。在R shiny/rcharts中呈現渲染後添加highcharts plotband

我不確定r軟件包中是否有這個功能，但是有沒有辦法放入javascript來執行該功能？

這裏有一個最小的工作示例：

server.R

library(shiny) 
library(plyr) 
library(rCharts) 
shinyServer(function(input, output,session){ 
    output$h1chart <- renderChart({ 
    h1 <- rCharts::Highcharts$new() 
    h1$chart(type = "spline") 
    h1$series(data = c(1, 3, 2, 4, 5, 4, 6, 2, 3, 5, NA), dashStyle = "longdash") 
    h1$series(data = c(NA, 4, 1, 3, 4, 2, 9, 1, 2, 3, 4), dashStyle = "shortdot") 
    h1$legend(symbolWidth = 80) 
    h1$xAxis(title = list(text = "Test Plot"),startOnTick=TRUE,min=1,max=9,endOnTick=TRUE, 
      plotBands = list(list(from=1.5,to=3.5,color='rgba(68, 170, 213, 0.1)',label=list(text="1",style=list(color="#6D869F"),verticalAlign="bottom")))) 
    h1$set(dom="h1chart") 
    return(h1) 
    }) 
    output$selectedOut <- renderUI({ 
    numericInput("selected", "", value=2.5) 
    }) 
    output$windowOut <- renderUI({  
    sliderInput(inputId="window",label="Window size around selected point:",min=1,max=5,value=2) 
    }) 
})#end server

ui.R：

library(shiny) 
library(plyr) 
library(rCharts) 
shinyUI(pageWithSidebar(
    headerPanel(""), 
    sidebarPanel(
    wellPanel(
     h6("Change here should update plotband:"), 
     uiOutput("selectedOut"), 
     uiOutput("windowOut") 
    ), 
    tags$head(tags$style(type="text/css", ".jslider { max-width: 245px; }"),tags$style(type='text/css', ".well { max-width: 250px; }"), 
      tags$style(type='text/css', ".row-fluid .span4 {width: 20%}\n.row-fluid .span8 {width: 75%}")) 
), 
    mainPanel(showOutput("h1chart","highcharts")) 
))

我可以捕捉更改數字盒/滑塊使用此功能：

addPB <- reactive({ 
    center <- as.numeric(input$selected[[1]]) 
    winHigh <- center+input$window[1] 
    winLow <- center-input$window[1] #eventually I would use winLow/winHigh to change the plotband range 
    list(winLow=winLow,winHigh=winHigh) 
}) 
observe(print(addPB()$winLow))

我已經嘗試過構建一個JavaScript函數來運行它們，但是如果這是如何使用javascript訪問highchart對象或者如何從閃亮執行代碼來執行，我不會這樣做。

#!function(){$('#container').highcharts().xAxis[0].addPlotBand({from: 2,to: 4, color: 'rgba(68, 170, 213, 0.1)', label: 'asdf'}); } !#

來源

2013-11-27 user3042363

您可以使用Shiny中的消息傳遞來完成此操作。下面是它的工作原理。無論何時更改滑塊或numericInput中的數據，都會使用session$sendCustomMessage以及json有效內容（在本例中爲band）向服務器發送消息。

在服務器端，該消息由Shiny.addCustomMessageHandler收到。我們訪問現有樂隊，將其刪除，然後使用處理程序收到的選項創建新樂隊。

對於消息的傳遞閃亮的更詳細的介紹，我建議閱讀本excellent blog post馬克的Heckmann

下面的代碼添加到server.R和ui.R

# addition to server.R 
observe({ 
    center <- as.numeric(input$selected[[1]]) 
    winHigh <- center + input$window[1] 
    winLow <- center - input$window[1] 
    #eventually I would use winLow/winHigh to change the plotband range 
    band = list(from = winLow, to = winHigh, color = "rgba(68, 170, 213, 0.1)") 
    print(band) 
    session$sendCustomMessage(type = "customMsg", band) 
}) 

# addition to ui.R 
mainPanel(
    showOutput("h1chart","highcharts"), 
    tags$script('Shiny.addCustomMessageHandler("customMsg", function(bandOpts){ 
    chartXAxis = $("#h1chart").highcharts().xAxis[0] 
    chartXAxis.removePlotBand() 
    chartXAxis.addPlotBand(bandOpts) 
    })') 
)

來源

2013-11-27 18:08:28 Ramnath

在R shiny/rcharts中呈現渲染後添加highcharts plotband

回答

相關問題