如何计算Shiny应用中daterange选择后表格的渲染耗时

完全可以实现该需求，统计的总耗时包含R端数据过滤处理耗时和前端DT表格渲染耗时两部分，通过前后端配合即可完成统计，以下是修改后的可直接运行的完整代码：

library(shiny)
library(shinythemes)
library(dplyr)
library(lubridate)
library(tidyr)
library(DT)

Test <- structure(list(date2 = structure(c(18808, 18808, 18809, 18810
), class = "Date"), Category = c("FDE", "ABC", "FDE", "ABC"), 
coef = c(4, 1, 6, 1)), row.names = c(NA, 4L), class = "data.frame")

ui <- fluidPage(
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 uiOutput('daterange'),
                                 br(),
                                 # 新增耗时展示区域
                                 h4("表格渲染总耗时："),
                                 textOutput("render_time")
                               ),
                               mainPanel(
                                 dataTableOutput('table')
                               )
                             ))
  ))

server <- function(input, output,session) {
  # 新增：存储计时起始时间
  rv <- reactiveValues(start_time = NULL)
  
  data <- reactive(Test)
  
  # 新增：监听daterange值变更，记录开始计时时间
  observeEvent(input$daterange1, {
    rv$start_time <- Sys.time()
    output$render_time <- renderText("计算中...")
  })
  
  data_subset <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    showModal(modalDialog("Wait", footer=NULL))
    on.exit(removeModal())
    All<- subset(data(), date2 %in% days)
    All<-All%>% mutate(date2 = format(ymd(date2), "%d/%m/%Y"))%>%
      mutate(TOTAL = rowSums(across(3:last_col()), na.rm = TRUE)) %>% 
      mutate(across(everything(), ~ replace_na(as.character(.), '-')))
  })
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   min = min(data()$date2),
                   max = max(data()$date2))
  })
  
  output$table <- renderDataTable({
    dat <- data_subset()
    datatable(dat,options = list( 
      columnDefs = list(list(className = 'dt-center', targets = "_all")),
      paging = TRUE,  searching = FALSE,pageLength = 10,dom = 'tip',  scrollx=TRUE,
      # 新增：DT渲染完成后回调通知Shiny后端
      initComplete = JS("
        function(settings, json) {
          Shiny.setInputValue('dt_render_done', true, {priority: 'event'});
        }
      ")
    ), rownames = FALSE) %>%
      formatRound(c(3:4), digits=0)
  })
  
  # 新增：收到前端渲染完成信号后计算总耗时
  observeEvent(input$dt_render_done, {
    total_cost <- round(difftime(Sys.time(), rv$start_time, units = "secs"), 2)
    output$render_time <- renderText(paste0(total_cost, " 秒"))
  })
}

shinyApp(ui = ui, server = server)

实现逻辑说明 #

• 每次daterange选择的日期范围发生变化时，立刻记录R端的起始计时时间
• 给DT组件添加initComplete回调事件，当前端表格完全渲染完成后，主动向Shiny后端发送完成信号
• 后端收到完成信号后，计算当前时间和起始时间的差值，即为从选定日期到表格完全展示的总耗时

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