我尝试从蚊子测试服务器获取流数据，以创建实时折线图。我检查了一些实时图表的例子，但我似乎无法达到同样的目标。图表是实时更新的，但它总是刷新。
这是我从一个例子编辑的脚本：
library(shiny)
library(magrittr)
library(mqtt)
library(jsonlite)
ui <- shinyServer(fluidPage(
plotOutput("plot")
))
server <- shinyServer(function(input, output, session){
myData <- data.frame()
# Function to get new observations
get_new_data <- function(){
d <- character()
mqtt::topic_subscribe(host = "test.mosquitto.org", port = 1883L, client_id = "dcR", topic = "IoTDemoData",
message_callback =
function(id, topic, payload, qos, retain) {
if (topic == "IoTDemoData") {
d <<- readBin(payload, "character")
# print(received_payload)
# received_payload <- fromJSON(received_payload)
# print(d)
return("quit")
}
}
)
d <- fromJSON(d)
d <- as.data.frame(d)
return(d)
# data <- rnorm(5) %>% rbind %>% data.frame
# return(data)
}
# Initialize my_data
myData <- get_new_data()
# Function to update my_data
update_data <- function(){
myData <<- rbind(get_new_data(), myData)
}
# Plot the 30 most recent values
output$plot <- renderPlot({
invalidateLater(1000, session)
update_data()
print(myData)
plot(temperature ~ 1, data=myData[1:30,], ylim=c(-20, -10), las=1, type="l")
})
})
shinyApp(ui=ui,server=server)
我一直在努力创建实时图表。如果有人可以指出问题为什么线图总是刷新和解决方案，将非常感谢！
以下是基于Florian回答的修订工作脚本：
library(shiny)
library(mqtt)
library(jsonlite)
library(ggplot2)
ui <- shinyServer(fluidPage(
plotOutput("mqttData")
))
server <- shinyServer(function(input, output, session){
myData <- reactiveVal()
get_new_data <- function(){
d <- character()
mqtt::topic_subscribe(host = "localhost", port = 1883L, client_id = "dcR", topic = "IoTDemoData",
message_callback =
function(id, topic, payload, qos, retain) {
if (topic == "IoTDemoData") {
d <<- readBin(payload, "character")
return("quit")
}
}
)
d <- fromJSON(d)
d <- as.data.frame(d)
return(d)
}
observe({
invalidateLater(1000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
myData(new_data)
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
})
})
output$mqttData <- renderPlot({
ggplot(mapping = aes(x = c(1:nrow(myData())), y = myData()$temperature)) +
geom_line() +
labs(x = "Second", y = "Celsius")
})
})
shinyApp(ui=ui,server=server)
然而，在添加第二个图后，闪烁开始了。当我评论出其中一个图时，情节很好，无需刷新。 库（闪亮） 库（MQTT） 库（jsonlite） 库（GGPLOT2）
ui <- shinyServer(fluidPage(
plotOutput("mqttData"),
plotOutput("mqttData_RH")
))
server <- shinyServer(function(input, output, session){
myData <- reactiveVal()
get_new_data <- function(){
d <- character()
mqtt::topic_subscribe(host = "test.mosquitto.org", port = 1883L, client_id = "dcR", topic = "IoTDemoData",
# mqtt::topic_subscribe(host = "localhost", port = 1883L, client_id = "dcR", topic = "IoTDemoData",
message_callback =
function(id, topic, payload, qos, retain) {
if (topic == "IoTDemoData") {
d <<- readBin(payload, "character")
return("quit")
}
}
)
d <- fromJSON(d)
d <- as.data.frame(d)
d$RH <- as.numeric(as.character( d$RH))
return(d)
}
observe({
invalidateLater(10000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
myData(new_data)
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
})
})
output$mqttData <- renderPlot({
ggplot(mapping = aes(x = c(1:nrow(myData())), y = myData()$temperature)) +
geom_line() +
labs(x = "Second", y = "Celsius")
})
output$mqttData_RH <- renderPlot({
ggplot(mapping = aes(x = c(1:nrow(myData())), y = myData()$RH)) +
geom_line() +
labs(x = "Second", y = "RH %")
})
})
shinyApp(ui=ui,server=server)
我发现一个解决方案在一个renderPlot对象中绘制图表。闪烁减少了。
output$mqttData <- renderPlot({
myData() %>%
gather('Var', 'Val', c(temperature, RH)) %>%
ggplot(aes(timestamp,Val, group = 1))+geom_line()+facet_grid(Var ~ ., scales="free_y")
})
但是，我想知道是否有办法单独绘制图表而不会闪烁/刷新。
我发现一个github示例使用管道％＆gt;％（https://github.com/mokjpn/R_IoT）将数据放入ggplot2并修改它以绘制分离的图表。
library(shiny)
library(ggplot2)
library(tidyr)
# Dashboard-like layout
ui <- shinyServer(fluidPage(
fluidRow(
column(
6,
plotOutput("streaming_data_1")
),
column(
6,
plotOutput("streaming_data_2")
)
),
fluidRow(
column(
6,
plotOutput("streaming_data_3")
),
column(
6,
plotOutput("streaming_data_4")
)
)
))
server <- shinyServer(function(input, output, session){
myData <- reactiveVal()
# show the first and last timestamp in the streaming charts
realtime_graph_x_labels <- reactiveValues(first = "",last ="")
get_new_data <- function(){
epochTimeStamp <- as.character(as.integer(Sys.time()))
sensor_1 <- -runif(1,min = 10, max = 30)
sensor_2 <- runif(1,min = 0,max = 100)
sensor_3 <- runif(1,min = 0,max = 100000)
sensor_4 <- runif(1,min = 0,max = 10)
newData <- data.frame(ts = epochTimeStamp, val_1 = sensor_1, val_2 = sensor_2, val_3 = sensor_3, val_4 = sensor_4)
return(newData)
}
observe({
invalidateLater(1000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
{
myData(new_data)
realtime_graph_x_labels$first <- as.character(head(myData()$ts,1))
}
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
realtime_graph_x_labels$last <- as.character(tail(myData()$ts,1))
})
})
# When displaying two charts, there is no flickering / refreshing, which is desired
output$streaming_data_1 <- renderPlot({
myData() %>%
ggplot(aes(ts,val_1, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 1") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
output$streaming_data_2<- renderPlot({
myData() %>%
ggplot(aes(ts,val_2, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 2") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
# When adding the 3rd chart, every charts start to flicker / refresh when ploting new value
output$streaming_data_3<- renderPlot({
myData() %>%
ggplot(aes(ts,val_3, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 3") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
output$streaming_data_4<- renderPlot({
myData() %>%
ggplot(aes(ts,val_4, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 4") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
})
shinyApp(ui=ui,server=server)
当只有两个图表并且在添加第三个图片时开始闪烁/刷新时，该解决方案可以正常工作。
答案 0 :(得分：1)
一个可能的原因可能是1000ms太短而数据无法完成处理。例如，尝试invalidateLater(10000, session)，看看会发生什么。
我无法使用我的R版本安装mqtt，因此我无法重现您的行为。但是，我查看了您的代码，我认为您可以采用不同的方法来改进代码：使用<<-将数据写入全局环境通常不是一个好主意。可能更适合的是reactiveVal，您可以在其中存储数据，以及哪些其他函数具有依赖性。因此，在下面的示例中，我创建了reactiveVal和相应的observer，每1000毫秒更新一次reactiveVal。
下面是一个工作示例，为了便于说明，我用简单的单行代替了函数的内容。
希望这有帮助！
set.seed(1)
library(shiny)
ui <- fluidPage(
plotOutput("plotx")
)
server <- function(input, output, session){
# A reactiveVal that holds our data
myData <- reactiveVal()
# Our function to get new data
get_new_data <- function(){
data.frame(a=sample(seq(20),1),b=sample(seq(20),1))
}
# Observer that updates the data every 1000ms.
observe({
# invalidate every 1000ms
invalidateLater(1000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
myData(new_data)
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
})
})
# Plot a histrogram
output$plotx <- renderPlot({
hist(myData()$a)
})
}
shinyApp(ui=ui,server=server)
基于新的可重复示例进行编辑。好像只需要一些时间来创建所有的情节。你可以添加
tags$style(type="text/css", ".recalculating {opacity: 1.0;}")
到你的应用程序，以防止它们闪烁。工作示例：
library(shiny)
library(ggplot2)
library(tidyr)
# Dashboard-like layout
ui <- shinyServer(fluidPage(
tags$style(type="text/css", ".recalculating {opacity: 1.0;}"),
fluidRow(
column(
6,
plotOutput("streaming_data_1")
),
column(
6,
plotOutput("streaming_data_2")
)
),
fluidRow(
column(
6,
plotOutput("streaming_data_3")
),
column(
6,
plotOutput("streaming_data_4")
)
)
))
server <- shinyServer(function(input, output, session){
myData <- reactiveVal()
# show the first and last timestamp in the streaming charts
realtime_graph_x_labels <- reactiveValues(first = "",last ="")
get_new_data <- function(){
epochTimeStamp <- as.character(as.integer(Sys.time()))
sensor_1 <- -runif(1,min = 10, max = 30)
sensor_2 <- runif(1,min = 0,max = 100)
sensor_3 <- runif(1,min = 0,max = 100000)
sensor_4 <- runif(1,min = 0,max = 10)
newData <- data.frame(ts = epochTimeStamp, val_1 = sensor_1, val_2 = sensor_2, val_3 = sensor_3, val_4 = sensor_4)
return(newData)
}
observe({
invalidateLater(1000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
{
myData(new_data)
realtime_graph_x_labels$first <- as.character(head(myData()$ts,1))
}
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
realtime_graph_x_labels$last <- as.character(tail(myData()$ts,1))
})
})
# When displaying two charts, there is no flickering / refreshing, which is desired
output$streaming_data_1 <- renderPlot({
myData() %>%
ggplot(aes(ts,val_1, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 1") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
output$streaming_data_2<- renderPlot({
myData() %>%
ggplot(aes(ts,val_2, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 2") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
# When adding the 3rd chart, every charts start to flicker / refresh when ploting new value
output$streaming_data_3<- renderPlot({
myData() %>%
ggplot(aes(ts,val_3, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 3") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
output$streaming_data_4<- renderPlot({
myData() %>%
ggplot(aes(ts,val_4, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 4") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
})
shinyApp(ui=ui,server=server)