Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to plot real time line chart for mqtt data without having to refresh the chart

Tags:

r

shiny

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.

like image 262
greenTea2Codes Avatar asked Nov 08 '22 10:11

greenTea2Codes


1 Answers

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)
like image 50
Florian Avatar answered Nov 15 '22 07:11

Florian