如何避免Shiny Dashboard刷新valueBox时出现闪烁问题

我使用Shiny模块更新大量value box，当value box数量超过10或20个时就会出现扩展异常，更新会引发明显闪烁。甚至下次无效化时数值未发生变化的box也会闪烁，理想状态下数值不变的box不应该被刷新。

下文提供了一个使用Shiny模块的典型Shiny应用来复现该问题：当N的取值为4或5时，box数量较少，更新可瞬时完成；当N提升至10时，闪烁已经可以明显感知，N=20时闪烁程度难以忍受。

ui.R #

## reprex ui.r
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(magrittr))
suppressPackageStartupMessages(library(shinydashboard))
suppressPackageStartupMessages(library(shinydashboardPlus))
suppressPackageStartupMessages(library(lubridate))
suppressPackageStartupMessages(library(shinyjs))

ui <- dashboardPage(
        header = dashboardHeader(title = "Reprex"),
        sidebar = dashboardSidebar(
                sidebarMenu(id = "sidebar",
                            menuItem(text = "Fuel prediction",tabName = "LIVE",icon = icon("tachometer-alt"))
                )
        ), # end of sidebarMenu
        body = dashboardBody(id="body",useShinyjs(),
                             tabItems(
                                     tabItem(tabName = "LIVE",h1("FUEL DISPENSATION"),
                                             fluidRow(id = "parameters",
                                                      column(width = 2,h3("STATION")),
                                                      column(width = 2,h4("TIME UPDT")),
                                                      column(width = 2,h4("TANK LEVEL")),
                                                      column(width = 2,h4("DISPENSED")),
                                                      column(width = 2,h4("REFUELLED"))
                                             ),
                                             uiOutput("st1"),
                                             uiOutput("st2"),
                                             uiOutput("st3"),
                                             uiOutput("st4"),
                                             uiOutput("st5"),
                                             uiOutput("st6"),
                                             uiOutput("st7"),
                                             uiOutput("st8"),
                                             uiOutput("st9"),
                                             uiOutput("st10"),
                                             uiOutput("st11"),
                                             uiOutput("st12"),
                                             uiOutput("st13"),
                                             uiOutput("st14"),
                                             uiOutput("st15"),
                                             uiOutput("st16"),
                                             uiOutput("st17"),
                                             uiOutput("st18"),
                                             uiOutput("st19"),
                                             uiOutput("st20")
                                     )
                             )
        ) # End of body
) # end of dashboard page

server.R #

## reprex server.R
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(shinydashboard))
suppressPackageStartupMessages(library(data.table))
source("modules.R")

shinyServer(function(input, output,session) {
        seqno <- reactiveVal(5)
        timer <- reactiveTimer(3000)
        observeEvent(timer(),{
                seqno((seqno() + 1))
                for(i in seq_len(N)){ ## the for loop generates all the output assignment statements using shiny module.
                        genrVB(i = i,output = output,s = seqno())
                }
        })
        
        # This is just to stop the app when session ends. Ignore for the purposes of this reprex.
        session$onSessionEnded(function() {
                print("Session ended")
                stopApp()
        })
})

modules.R #

### Shiny module reprex
library(shiny)
library(purrr)
library(maps)
# take N cities and N data.tables randomly generated to serve our input data for the shiny app
N <- 4
cities <-  world.cities %>% as.data.table() %>% .$name %>% sample(N)

### Generate N simulated data.tables for the N cities.
### Notice the values of the column 2,3,4 donot change every minute.
simdata <- purrr::map(seq_len(N),
                      ~data.table(ts = seq.POSIXt(Sys.time(),by = 60,length.out = 100),
                                  fuel = rep(c(5000:5004),each = 2),
                                  out =  rep(c(100,110),each = 25),
                                  fill = rep(c(100,200),each = 10)
                                  ))

fuelrowUI <- function(id,label = "Site X",n = 1){
        ns <- NS(id)
        fluidRow(id = ns("siteid"),
                 column(2,h3(cities[n])),
                 valueBoxOutput(ns("upd"),width = 2),
                 valueBoxOutput(ns("tank"),width = 2),
                 valueBoxOutput(ns("out"),width = 2),
                 valueBoxOutput(ns("fill"),width = 2)
        )
}

fuelrowServer <- function(id,datarow=1,n = 1){
        moduleServer(id,
                     function(input,output,session){
                             output$upd <- renderValueBox(vbtime(n,k = datarow))
                             output$tank <- renderValueBox(vblevel(n,k = datarow))
                             output$out <- renderValueBox(vbout(n,k = datarow))
                             output$fill <- renderValueBox(vbin(n,k = datarow))
                     })
}

# Function to loop through the output$.. in server.R using the two shiny modules
genrVB <- function(i,s,output = output){
        stn <- paste0("st",i)
        output[[stn]] <- renderUI(fuelrowUI(stn,label = "DUMMY",n = i))
        fuelrowServer(stn,datarow = s,n = i)
}


##### Value box helper functions ##########
vblevel <- function(n = 1,k=1){
        val <- simdata[[n]][k,round(fuel,0)]
        valueBox(value = paste(val,"L"), 
                 subtitle = tags$h4(cities[n]),
                 color = case_when(
                         val < 1000 ~ "red",
                         val >= 1000 ~ "green"
                 ))
}

vbout <- function(n = 1,k=1){
        val = simdata[[n]][k,out]
        valueBox(value = paste(val,"L"), 
                 subtitle = tags$h4(cities[n]),
                 color = case_when(
                         val < 100 ~ "aqua",
                         val >= 100 ~ "purple"
                 ))
}

vbin <- function(n = 1,k=1){
        val = simdata[[n]][k,fill]
        valueBox(value = paste(val,"L"), 
                 subtitle = tags$h4(cities[n]),
                 color = case_when(
                         val < 100 ~ "teal",
                         val >= 100 ~ "olive"
                 ))
}

# Time Value box
vbtime <- function(n = 1,k = 1){
        time <-simdata[[n]][k,ts]
        timestr <- format(time,"%H:%M")
        valueBox(value = timestr,
                 subtitle = "Last Updated",color = "aqua")
}

请将三段代码分别存入三个文件：ui.R、server.R和modules.R。
注意：modules.R的第一行有代码N <- 4，请将其设置为20即可观察到明显的闪烁问题。

内容的提问来源于stack exchange，提问作者Lazarus Thurston