更新数据 table 闪亮

Question

我正在创建一个闪亮的应用程序，其中包含各种绘图。它还包括一个 table，它根据用户的日期范围规范进行更新。这很好用，但是当我最初加载应用程序时， table 应该在的地方有一个空白点。理想情况下，我希望这个空白 space 在用户更新日期范围规范或单击提交按钮之前显示数据集样本。有没有办法在闪亮的情况下做到这一点？我试过 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)

更新数据 table 闪亮

Update data table in shiny

datatable

proxy

r

shiny