When you run code below, you will notice that a table will be generated automatically. However, I would like to generate this table only after choosing the start and end dates of my dateRange
. How can I do this? I inserted an executable code below for you to test.
Thanks in advance!
library(shiny)
library(shinythemes)
library(dplyr)
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'),
br(), br(),
downloadButton("dl", "Download")
),
))
))
server <- function(input, output,session) {
data <- reactive(Test)
output$daterange <- renderUI({
tagList(dateRangeInput("daterange1", "Period you want to see:",
start = min(data()$date2),
end = max(data()$date2),
min = min(data()$date2),
max = max(data()$date2),
tags$script(HTML('
setTimeout(function(){
$("#daterange1 input")[0].value = "No date selected";
$("#daterange1 input")[1].value = "No date selected";
}, 50);
'))))
})
data_subset <- reactive({
req(input$daterange1)
days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
subset(data(), date2 %in% days)
})
output$table <- renderDataTable({
data_subset()
})
output$dl <- downloadHandler(
filename = function() { "data.xlsx"},
content = function(file) {
writexl::write_xlsx(data_subset(), path = file)
}
)
}
shinyApp(ui = ui, server = server)
CodePudding user response:
To be honest I preferred your version of the app, but here is the solution, if you take out the start and end the user has to know beforehand the dates to pick, you can aleviate this by messaging good starting dates but anyway...
library(shiny)
library(shinythemes)
library(dplyr)
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'),
br(), br(),
downloadButton("dl", "Download")
),
))
))
server <- function(input, output,session) {
data <- reactive(Test)
output$daterange <- renderUI({
tagList(dateRangeInput("daterange1", "Period you want to see:",
min = min(data()$date2),
max = max(data()$date2),
tags$script(HTML('
setTimeout(function(){
$("#daterange1 input")[0].value = "No date selected";
$("#daterange1 input")[1].value = "No date selected";
}, 50);
'))))
})
data_subset <- reactive({
req(input$daterange1)
req(input$daterange1[1] < input$daterange1[2])
days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
subset(data(), date2 %in% days)
})
output$table <- renderDataTable({
data_subset()
})
output$dl <- downloadHandler(
filename = function() { "data.xlsx"},
content = function(file) {
writexl::write_xlsx(data_subset(), path = file)
}
)
}
shinyApp(ui = ui, server = server)