带有 ping 的反应式仪表导致 R 闪亮

Question

我正在为需要向不同服务器显示一些 ping 结果的工作构建仪表板。我的想法是构建一个闪亮的 R 仪表板来显示一些带有这些 ping 结果的仪表。我已经制作了一个工作量表和一个可以 ping 不同服务器的工作循环。我已经在互联网上为此搜索了一个解决方案，但我似乎无法让这两件事一起工作。我想我需要使用反应式仪表，但我真的不习惯用 R 编程。

这是我目前在体内得到的：

#Body
#-----------------------------------------------------------------------
body <- dashboardBody(
          tabItems(
            #First tab content
            tabItem(tabName = "dashboard",
              #Connection speeds
              #-----------------------------------------------------------------------
              fluidRow(
                h2("Server connections and speeds"),
                column(6,box(flexdashboard::gaugeOutput("out1"),width=12,title="Gauge Graph")),
                column(6,box(flexdashboard::gaugeOutput("out2"),width=12,title="Gauge Graph 2"))
              )
            )
          )
        )

这些是我的服务器功能：

#Server functions
#=======================================================================
server <- shinyServer(function(input, output, session) {

#server section
    ping_result_cw <- ping_port("google.com")
    print(ping_result_cw[1])
    output$out1 <- flexdashboard::renderGauge({
      gauge(ping_result_cw[1], min = 0, max = 250, symbol = 'ms', label = paste("Verbinding Careware"),gaugeSectors(
        success = c(250, 150), warning = c(150,50), danger = c(0, 50), colors = c("#CC6699")
      ))

    })
    output$out2 <- flexdashboard::renderGauge({
      gauge(26, min = 0, max = 250, symbol = 'ms', label = paste("Verbinding Ksyos"),gaugeSectors(
        success = c(100, 6), warning = c(5,1), danger = c(0, 1), colors = c("#CC6699")
      ))
    })
  })
}
#Run UI
#=======================================================================
shinyApp(ui = ui, server = server)

这里的第二个仪表是一个控制仪表，用于查看我的更改是否已通过。我没有在这部分代码中放置循环，因为当我这样做时它会失败。有谁知道我怎样才能让我的代码每 5 秒 ping 一次（可能在循环中使用 Sys.sleep(5)）并更新仪表？我让它与运行一次 ping 循环一起工作，但随后仪表将只显示第一个 ping 结果。

简而言之：我需要一个闪亮的 R 仪表板，带有多个仪表，显示每 5 秒更新一次的 ping 结果。 提前谢谢！

Answer 1

我们可以使用 Shiny 的 reactive 和 invalidateLater 来实现。

## Read in necessary libraries, function, and data 
library(shiny)
library(shinydashboard)
library(flexdashboard)
ui <- dashboardBody(
    tabItems(
        #First tab content
        tabItem(tabName = "dashboard",
                #Connection speeds
                #-----------------------------------------------------------------------
                fluidRow(
                    h2("Server connections and speeds"),
                    column(6,box(flexdashboard::gaugeOutput("out1"),width=12,title="Gauge Graph")),
                    column(6,box(flexdashboard::gaugeOutput("out2"),width=12,title="Gauge Graph 2"))
                )
        )
    )
)
#Server functions
#=======================================================================
server <- shinyServer(function(input, output, session) {
    
    #server section
    ping_result_cw <- reactive({
        invalidateLater(5000)
        pingr::ping_port("google.com", timeout = 3)
    })
    output$out1 <- flexdashboard::renderGauge({
        gauge(ping_result_cw()[1], min = 0, max = 250, symbol = 'ms', label = paste("Verbinding Careware"),gaugeSectors(
            success = c(250, 150), warning = c(150,50), danger = c(0, 50), colors = c("#CC6699")
        ))
        
    })
    output$out2 <- flexdashboard::renderGauge({
        gauge(26, min = 0, max = 250, symbol = 'ms', label = paste("Verbinding Ksyos"),gaugeSectors(
            success = c(100, 6), warning = c(5,1), danger = c(0, 1), colors = c("#CC6699")
        ))
    })
})
}
#Run UI
#=======================================================================
shinyApp(ui = ui, server = server)