r - 计算表格显示所需的时间

Question

我想知道在我选择开始和结束日期后，是否可以计算表格在 Shiny 中显示需要多长时间daterange？有可能的？

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()
                                 
                               ),
                               mainPanel(
                                 dataTableOutput('table')

                               )
                             ))
  ))

server <- function(input, output,session) {
  
  data <- reactive(Test)

    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({
    data_subset()
     datatable(data_subset(),options = list( columnDefs = list(
          list(className = 'dt-center', targets = "_all")),
        paging = TRUE,  searching = FALSE,pageLength = 10,dom = 'tip',  scrollx=TRUE),    rownames = FALSE) %>%
      formatRound(c(3:4), digits=0)
  })
  
}

shinyApp(ui = ui, server = server)

标签： rshiny

Answer 1

您可以创建一个reactiveVal来存储daterange修改触发data_subset更新的时间，并使用它在控制台中打印显示表格之前所花费的时间：

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()
                                 
                               ),
                               mainPanel(
                                 dataTableOutput('table')
                                 
                               )
                             ))
  ))

server <- function(input, output,session) {
  
  data <- reactive(Test)
  tic <- reactiveVal()
  
  data_subset <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    
    # Store range change time
    tic(Sys.time())
    
    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({
    data_subset()
    # Print time difference in console
    cat('Time to display:',round(Sys.time()-tic(),3),'s\n')
    
    datatable(data_subset(),options = list( columnDefs = list(
      list(className = 'dt-center', targets = "_all")),
      paging = TRUE,  searching = FALSE,pageLength = 10,dom = 'tip',  scrollx=TRUE),    rownames = FALSE) %>%
      formatRound(c(3:4), digits=0)
  })
  
}

shinyApp(ui = ui, server = server)