我正在尝试在运行 rCharts 和 Shiny 的应用程序中复制这个( jsfiddle )highcharts 功能。我想要一个用户事件(更改文本框中的值)将绘图带添加到已呈现的绘图(或理想情况下删除以前的/添加新的绘图)。我可以通过在 xAxis 选项中使用 plotband 重绘绘图来使其工作,但这对于我正在绘制的某些绘图来说可能非常慢。
我不确定 r 包中是否有该功能,但是有没有办法进入 javascript 来执行该功能?
这是一个最小的工作示例:
服务器
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
用户界面:
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 对象或如何让代码从 Shiny 的地方执行。
#!function(){$('#container').highcharts().xAxis[0].addPlotBand({from: 2,to: 4, color: 'rgba(68, 170, 213, 0.1)', label: 'asdf'}); } !#
最佳答案
你可以通过在 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)
})')
)
关于r - 在 R Shiny/rcharts 中渲染后添加 highcharts plotband,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/20247759/