具有 ping 功能的反应式仪表会导致 R 闪亮

Question

我正在为需要向不同服务器显示一些 ping 结果的工作构建仪表板。我的想法是构建一个 R shiny 仪表板来显示一些带有这些 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)

具有 ping 功能的反应式仪表会导致 R 闪亮

Reactive gauge with ping results in R shiny

r

ping

gauge

shiny