I tried to fetch streaming data from mosquito test server for creating a real time line chart. I checked some examples of real time chart, but I couldn't seem to achieve the same objective. The chart is updated real time but it always refreshes.
Here is the script I edited from one example:
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)
I have been struggling with creating real time chart for days. If anyone can point out the problem why the line chart is always refreshed and the solution, it will be highly appreciated!
Below are the revised working script based on Florian's answer:
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)
However, after adding a second plot, the flickering began. When I commented out one of the plots, the plot works great without the need to refresh. library(shiny) library(mqtt) library(jsonlite) library(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)
One solution I found plot the charts in one renderPlot object. The flickering reduces.
output$mqttData <- renderPlot({
myData() %>%
gather('Var', 'Val', c(temperature, RH)) %>%
ggplot(aes(timestamp,Val, group = 1))+geom_line()+facet_grid(Var ~ ., scales="free_y")
})
However, I wonder if there is way to plot the charts separately without flickering / refreshing.
I found one github example put data to ggplot2 using pipe %>% (https://github.com/mokjpn/R_IoT) and modified it to plot separated charts.
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)
The solution works when there are only two charts and starts flickering / refreshing when adding the 3rd.
One possible cause may be that 1000ms is too short for the data to finish processing. Try invalidateLater(10000, session)
for example, and see what happens.
I was unable to install mqtt
with my R version, so I am unable to reproduce your behavior. However, I looked at your code and I think there is something you could do different to improve your code: Writing data to the global environment with <<-
is usually not a good idea. What might be better suited is a reactiveVal
, in which you can store data, and on which other functions take a dependency. So in the example below, I have created a reactiveVal
and a corresponding observer
that updates the reactiveVal
every 1000ms.
Below is a working example, where I replaced the contents of your function with a simple one-liner for illustration purposes.
Hope this helps!
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)
EDIT based on new reproducible example. Seems like it just takes some time to create all the plots. You can add
tags$style(type="text/css", ".recalculating {opacity: 1.0;}")
to your app to prevent them from flickering. Working example:
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With