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一次。您可以如下所示在watchEvent中更新数据框。另外，您可能需要更新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)

更新闪亮的数据表

1 个答案: