Блог

Я создаю блестящее приложение, в котором есть различные графики. Он также включает в себя таблицу, которая обновляется в соответствии со спецификацией пользовательского диапазона дат. Это отлично работает, но когда я изначально загружаю приложение, там, где должна быть таблица, остается пустое место. В идеале я хотел бы, чтобы в этом пустом пространстве отображался образец набора данных еще до того, как пользователь обновит спецификацию диапазона дат или нажмет кнопку отправки. Есть ли способ сделать это в shiny? Я пробовал 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)
  

Я бы предложил создать 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)