如何绘制 mqtt 数据的实时折线图而无需刷新图表

Question

我尝试从蚊子测试服务器获取流数据以创建实时折线图。我检查了一些实时图表示例，但似乎无法实现相同的目标。图表会实时更新，但始终会刷新。

这是我从一个示例中编辑的脚本：

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 示例使用管道 %>% (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)

该解决方案在只有两个图表时有效，并在添加第三个时开始闪烁/刷新。

Answer 1

一个可能的原因可能是 1000 毫秒太短，数据无法完成处理。试试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)