更新闪亮的数据表

Question

我正在创建一个闪亮的应用程序，其中包含各种情节。它还包括一个使用用户日期范围规范更新的表格。这很好用，但是当我最初加载应用程序时，表格应该是一个空白点。理想情况下，我希望这个空白区域在用户更新日期范围规范或单击提交按钮之前显示数据集的样本。有没有办法在闪亮的情况下做到这一点？我试过 dataTableProxy()，但没有成功。这是我的代码和数据示例。

样本数据：

County        State Case   Count   Death Count
Cook          Illinois     18451   99
Los Angeles   California   15704   167
El Paso       Texas        11713   37
Maricopa      Arizona      6456    54
Tarrant       Texas        6448    42
Harris        Texas        6219    71
Salt Lake     Utah         6216    18
Milwaukee     Wisconsin    6057    29
Miami-Dade    Florida      5943    87
Clark         Nevada       5384    38

代码：

library(shiny)
library(shinycssloaders)
library(DT)

## Reads data
temp <- read.csv()

## Creates Initial Table 
table0 <- head(temp[order(temp$Count, decreasing = TRUE),], 10)

ui <- fluidPage(      

  ## Application title
  titlePanel("Project"),
  tags$hr(),
  ## Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("daterange", "Date Range:",
                     start = as.character(Sys.Date() - 6),
                     end = as.character(Sys.Date()),
                     min = "2020-01-22",
                     max = Sys.Date()),
      checkboxInput("checkBox", "Select all dates", FALSE),
      textOutput("dateCheck"),
      selectInput("typeChoice", "Data Type:", choices = c("Raw", "Percentage")),
      actionButton("submitButton", "Submit", class = "btn btn-primary")
    ),

    mainPanel(
      withSpinner(tableOutput('table'))
    )
  )
)

server <- function(input, output, session) {
  
  observe({
    if (input$checkBox == TRUE){
      updateDateRangeInput(session,
                           "daterange",
                           "Date Range:",
                           start = "2020-01-22",
                           end = Sys.Date(),
                           min = "2020-01-22",
                           max = Sys.Date())
    }
  })
  
  ## Displays Initial Table
  output$table <- renderTable(table0)
    
  observeEvent(input$submitButton, {
    
    ## Updates data ##
    if (input$typeChoice == "Raw"){
      df <- selectdates(start = input$daterange[1], end = input$daterange[2])
      df$Total <- df$Count_Sum
    } else if (input$typeChoice == "Percentage"){
      df <- selectdates(start = input$daterange[1], end = input$daterange[2])
      df$Total <- df$Perc_Sum
    } else {return(NULL)}
    
    df <- df[order(df$`Variable of Interest`, decreasing = TRUE),]
    df <- df[, -c(1, 4, 5, 9)]
    df$`Case Count` <- as.integer(df$`Count`)
    df$`Death Count` <- as.integer(df$`Death Count`)

    ## THIS IS WHERE THE PROBLEM IS ##
    ## Trying to update table with click of button ##    
    output$table <- renderTable({
        head(df[order(df$Count, decreasing = TRUE),], 10)
    })

  })  
}

## Run the application 
shinyApp(ui = ui, server = server)

Answer 1

我的建议是创建一个reactiveValues 对象来显示和定义output$table 一次。您可以更新observeEvent 中的数据框，如下所示。此外，您可能需要更新您的filter。

## Reads data
#temp <- read.csv()

temp<- gapminder[1:1000,]
temp$Count <- temp$fertility
temp$Count_Sum <- temp$population
temp$Perc_Sum  <- temp$life_expectancy

temp <- as.data.frame(temp)

## Creates Initial Table 
table0 <- head(temp[order(temp$Count, decreasing = TRUE),], 10)

ui <- fluidPage(      
  
  ## Application title
  titlePanel("Project"),
  tags$hr(),
  ## Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("daterange", "Date Range:",
                     start = as.character(Sys.Date() - 6),
                     end = as.character(Sys.Date()),
                     min = "1920-01-22",
                     max = Sys.Date()),
      checkboxInput("checkBox", "Select all dates", FALSE),
      textOutput("dateCheck"),
      selectInput("typeChoice", "Data Type:", choices = c("Raw", "Percentage")),
      actionButton("submitButton", "Submit", class = "btn btn-primary")
    ),
    
    mainPanel(
      withSpinner(tableOutput('table'))
    )
  )
)

server <- function(input, output, session) {
  DF1 <- reactiveValues(data=NULL)
  observe({
    DF1$data <- table0
    if (input$checkBox == TRUE){
      updateDateRangeInput(session,
                           "daterange",
                           "Date Range:",
                           start = "2020-01-22",
                           end = Sys.Date(),
                           min = "1920-01-22",
                           max = Sys.Date())
    }
  })
  
  ## Displays Initial Table
  output$table <- renderTable(DF1$data)
  
  observeEvent(input$submitButton, {
    
    ## Updates data ##
    if (input$typeChoice == "Raw"){
      df <- temp # %>% filter(year, between(year, input$daterange[1], input$daterange[2]))
      df$Total <- df$Count_Sum
    } else if (input$typeChoice == "Percentage"){
      df <- temp # %>% filter(year, between(year, input$daterange[1], input$daterange[2]))
      #df <- selectdates(start = input$daterange[1], end = input$daterange[2])
      df$Total <- df$Perc_Sum
    } else {return(NULL)}
    
    #df <- df[order(df$`Variable of Interest`, decreasing = TRUE),]
    #df <- df[, -c(1, 4, 5, 9)]
    #df$`Case Count` <- as.integer(df$`Count`)
    #df$`Death Count` <- as.integer(df$`Death Count`)
    
    ## THIS IS WHERE THE PROBLEM IS ##
    ## Trying to update table with click of button ##    
    DF1$data <- df
    # output$table <- renderTable({
    #   head(df[order(df$Count, decreasing = TRUE),], 10)
    # })
    
  })  
}

## Run the application 
shinyApp(ui = ui, server = server)