我正在使用来自Joshua Kunst的新的高图r包。我已成功编辑了他的一个examples in Shiny:
server.r:
library(shiny)
library(data.table)
shinyServer(function(input, output) {
output$Macroplot2 <- renderHighchart({
inputname<-input$name
#h
hc<-highchart() %>%
hc_chart(animation = FALSE) %>%
hc_title(text = "Macro data") %>%
hc_xAxis(categories=as.character(1:5),#tickInterval=4,#type='datetime',
labels=list(rotation=45),
plotBands=list(list(label=list(text='Forecast period',align='center',verticalAlign='top'),color="#edf2f7",from=0,to=2),
list(label=list(text='Calibration period',align='center',verticalAlign='top'),color="#ffffff",from=3,to=4)
)) %>%
hc_yAxis(
list(
title = list(text = "Loss"),
align = "left",
showFirstLabel = FALSE,
showLastLabel = FALSE#,
#labels = list(format = "{value} °C", useHTML = TRUE)
),
list(
title = list(text = inputname),
align = "right",
showFirstLabel = FALSE,
showLastLabel = FALSE,
#labels = list(format = "{value} mm"),
opposite = TRUE
),
list(
title = list(text = "two"),
align = "right",
showFirstLabel = FALSE,
showLastLabel = FALSE,
#labels = list(format = "{value} mm"),
opposite = TRUE
)
) %>%
hc_plotOptions(
series = list(
#stickyTracking = FALSE,
point = list(
events = list(
drop = JS("function(){
console.log(this.series)
window.data = _.map(this.series.data, function(e) { return e.y })
if(this.series.name==document.getElementById('name').value){Shiny.onInputChange('line1', data)}
else {Shiny.onInputChange('line2', data)}
}"))
))) %>%
hc_add_series(name = inputname, type = 'line', color = 'red',
#data = c(7.0, 6.9, 9.5, 14.5, 18.2, 21.5, 25.2, 26.5, 23.3, 18.3, 13.9, 9.6),
data=c(7.0, 6.9, 9.5, 14.5, 18.2),yAxis=1,
draggableY = TRUE
)%>%
hc_add_series(name = "One", type = 'line', color = 'blue',
#data = c(7.0, 6.9, 9.5, 14.5, 18.2, 21.5, 25.2, 26.5, 23.3, 18.3, 13.9, 9.6),
data=c(14.5, 18.2, 21.5, 25.2, 26.5),yAxis=2,
draggableY = TRUE
) %>%
hc_add_series(name =paste0('Loss'), type = 'line', color = 'black',
#data = c(49.9, 71.5, 106.4, 129.2, 144.0, 176.0, 135.6, 148.5, 216.4, 194.1, 95.6, 54.4))
data=c(1:5),
draggableY = FALSE)
})
output$table <-renderDataTable({
if(is.null(input$line1)) var <- c(7.0, 6.9, 9.5, 14.5, 18.2) else var <- input$line1
if(is.null(input$line2)) var2 <- c(14.5, 18.2, 21.5, 25.2, 26.5) else var2 <- input$line2
#var <- var[(length(var)-input$n.ahead+1):length(var)]
#Output from graph
table <- data.table(var,var2)#Here I want to use the dragged data. something linke input$highchart$... should do the trick I guess...
names(table)<-c('One',input$name)
table
})
})
ui.r:
library(shiny)
library(highcharter)
shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
selectInput("name",label = "name",choices = c("First","Second"),selected = "First"),
# plotOutput("distPlot"),
highchartOutput("Macroplot2")
,dataTableOutput('table')
)
)
))
我想解析我在this SO question中使用input$name
尝试过的javascript代码中的document.getElementById('name').value
,我也尝试了来自this SO question的$('#name').val()
。所以我希望如果我拖动名为First或Second的行,表格会相应地更改。