这是我的代码,类似于我今天已经发布的问题。现在我有另一个问题,我无法解决。当我单击actionButton
更新图表时,图表仅在第二次单击后更新。 print
语句在第一次单击后起作用。怎么了?
library(highcharter)
library(shiny)
library(shinyjs)
df <- data.frame(
a = floor(runif(10, min = 1, max = 10)),
b = floor(runif(10, min = 1, max = 10))
)
updaterfunction <- function(chartid, sendid, df, session) {
message = jsonlite::toJSON(df)
session$sendCustomMessage(sendid, message)
jscode <- paste0('Shiny.addCustomMessageHandler("', sendid, '", function(message) {
var chart1 = $("', chartid, '").highcharts()
var newArray1 = new Array(message.length)
var newArray2 = new Array(message.length)
for(var i in message) {
newArray1[i] = message[i].a
newArray2[i] = message[i].b
}
chart1.series[0].update({
// type: "line",
data: newArray1
}, false)
chart1.series[1].update({
// type: "line",
data: newArray2
}, false)
console.log("code was run")
chart1.redraw();
})')
print("execute code!")
runjs(jscode)
}
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Update highcharter dynamically"),
#includeScript("www/script.js"),
useShinyjs(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
actionButton("data", "Generate Data")
),
# Show a plot of the generated distribution
mainPanel(
highchartOutput("plot")
)
)
)
server <- function(input, output, session) {
observeEvent(input$data, {
df1 <- data.frame(
a = floor(runif(10, min = 1, max = 10)),
b = floor(runif(10, min = 1, max = 10))
)
updaterfunction(chartid = "#plot", sendid = "handler", df = df1, session = session)
})
output$plot <- renderHighchart({
highchart() %>%
hc_add_series(type = "bar", data = df$a) %>%
hc_add_series(type = "bar", data = df$b)
})
}
# Run the application
shinyApp(ui = ui, server = server)
答案 0 :(得分:1)
只需在ignoreNULL=FALSE
函数中添加observeEvent
-
我注意到@ismirsehregal在评论中提到了这个技巧。
工作代码-
library(highcharter)
library(shiny)
library(shinyjs)
df <- data.frame(
a = floor(runif(10, min = 1, max = 10)),
b = floor(runif(10, min = 1, max = 10))
)
updaterfunction <- function(chartid, sendid, df, session) {
message = jsonlite::toJSON(df)
session$sendCustomMessage(sendid, message)
jscode <- paste0('Shiny.addCustomMessageHandler("', sendid, '", function(message) {
var chart1 = $("', chartid, '").highcharts()
var newArray1 = new Array(message.length)
var newArray2 = new Array(message.length)
for(var i in message) {
newArray1[i] = message[i].a
newArray2[i] = message[i].b
}
chart1.series[0].update({
// type: "line",
data: newArray1
}, false)
chart1.series[1].update({
// type: "line",
data: newArray2
}, false)
console.log("code was run")
chart1.redraw();
})')
print("execute code!")
runjs(jscode)
}
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Update highcharter dynamically"),
#includeScript("www/script.js"),
useShinyjs(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
actionButton("data", "Generate Data")
),
# Show a plot of the generated distribution
mainPanel(
highchartOutput("plot")
)
)
)
server <- function(input, output, session) {
observeEvent(input$data, ignoreNULL = FALSE, {
df1 <- data.frame(
a = floor(runif(10, min = 1, max = 10)),
b = floor(runif(10, min = 1, max = 10))
)
print(df1)
updaterfunction(chartid = "#plot", sendid = "handler", df = df1, session = session)
})
output$plot <- renderHighchart({
highchart() %>%
hc_add_series(type = "bar", data = df$a) %>%
hc_add_series(type = "bar", data = df$b)
})
}
# Run the application
shinyApp(ui = ui, server = server)
答案 1 :(得分:1)
我想问题是,第一次执行observeEvent(input$data, {...})
之后,您将为情节附加事件处理程序(实际上,每单击一次按钮,您都会添加一个CustomMessageHandler)。因此,在第一次单击按钮期间事件处理程序尚未附加(并且无法响应)。
如果您在会话启动时初始化CustomMessageHandler
一次,并且仅在按钮上发送新消息,则单击该按钮将按预期工作:
library(highcharter)
library(shiny)
library(shinyjs)
df <- data.frame(
a = floor(runif(10, min = 1, max = 10)),
b = floor(runif(10, min = 1, max = 10))
)
updaterfunction <- function(sendid, df, session) {
message = jsonlite::toJSON(df)
session$sendCustomMessage(sendid, message)
}
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Update highcharter dynamically"),
#includeScript("www/script.js"),
useShinyjs(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
actionButton("data", "Generate Data")
),
# Show a plot of the generated distribution
mainPanel(
highchartOutput("plot")
)
)
)
server <- function(input, output, session) {
sendid <- "handler"
chartid <- "#plot"
jscode <- paste0('Shiny.addCustomMessageHandler("', sendid, '", function(message) {
var chart1 = $("', chartid, '").highcharts()
var newArray1 = new Array(message.length)
var newArray2 = new Array(message.length)
for(var i in message) {
newArray1[i] = message[i].a
newArray2[i] = message[i].b
}
chart1.series[0].update({
// type: "line",
data: newArray1
}, false)
chart1.series[1].update({
// type: "line",
data: newArray2
}, false)
console.log("code was run")
chart1.redraw();
})')
runjs(jscode)
observeEvent(input$data, {
df1 <- data.frame(
a = floor(runif(10, min = 1, max = 10)),
b = floor(runif(10, min = 1, max = 10))
)
updaterfunction(sendid = sendid, df = df1, session = session)
})
output$plot <- renderHighchart({
highchart() %>%
hc_add_series(type = "bar", data = df$a) %>%
hc_add_series(type = "bar", data = df$b)
})
}
# Run the application
shinyApp(ui = ui, server = server)
最后,ignoreNULL = FALSE
的作用也是这样:它在会话启动期间附加CustomMessageHandler
。
也请检查此有用的article