在 R Shiny/rcharts 中渲染后添加 highcharts plotband答案

【问题标题】：Add highcharts plotband after render in R shiny/rcharts在 R Shiny/rcharts 中渲染后添加 highcharts plotband
【发布时间】：2013-11-27 16:24:27
【问题描述】：

我正在尝试在运行 rCharts 和闪亮的应用程序中复制此 (jsfiddle) highcharts 功能。我希望用户事件（更改文本框中的值）将绘图带添加到已渲染的绘图（或理想情况下删除以前的绘图/添加新绘图）。我可以通过在 xAxis 选项中使用 plotband 重新绘制绘图来使其工作，但对于我正在绘制的某些绘图来说，这可能真的很慢。

我不确定 r 包中是否有该功能，但有没有办法放入 javascript 来执行该功能？

这是一个最小的工作示例：

服务器.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'}); } !#

【问题讨论】：

标签： r highcharts shiny rcharts

【解决方案1】：

您可以通过使用 Shiny 中的消息传递来做到这一点。下面是它的工作原理。每当您更改滑块或 numericInput 中的数据时，都会使用 session$sendCustomMessage 连同 json 有效负载（在本例中为 band）向服务器发送一条消息。

在服务器端，消息由Shiny.addCustomMessageHandler 接收。我们访问现有的带区，将其移除，然后使用处理程序接收到的选项创建一个新带区。

要更详细地了解 Shiny 中的消息传递，我建议您阅读 Mark Heckmann 撰写的 excellent blog post

将以下代码添加到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)
   })')
)

【讨论】：