如何在 R Shiny 中添加日期过滤器？

Question

Could someone please help me out, I'm stuck on how to filter on a date? I have no idea how to implement this.

And I don't understand how to put the two wellpanels, right next to each other. Whatever I tried it looked horrible.

Kind regards!

library(shiny)
library(dplyr)
library(DT)

{
  ui <- fluidPage(



    fluidRow(
      list(tags$head(HTML('<link rel="icon", href="fa.svg",
                                   type="image/svg" />'))),
      div(style="padding: 0px 0px; width: 0px; height: 0px",
          titlePanel(
            title="", windowTitle="Dashboard"
          )
      ),
      h2(id="title", "Dashboard"),
      tags$style(HTML("#title{color: white; background-color: #d52b1e; padding-left: 100px; padding-top: 18px; padding-bottom: 18px;}")) #font-weight: bold; 
    ),


    navlistPanel(
      tabPanel("D",
        fluidRow(
        # column(1), ## this put an extra space, dont like the look
        column(2,
               wellPanel(uiOutput("groups")),

        ),
        ),
        # fluidRow(
          column(2),
          column(2,
              wellPanel(
                 dateRangeInput('dateRange',
                                label = 'Filter op datum',
                                start = as.Date('2019-01-01') , end = as.Date('2019-12-31')
                 )
               ),
          ),
               column(2,
                      dataTableOutput('my_table')
               ),

        # ),
        # column(2)
      # ), ## this closes fluidrow below tabPanel 

      fluidRow(
        # column(1),
        column(8,
               tabsetPanel(type = "tabs",
                           # Tabbladen voor visueel of tabel
                           tabPanel("Staafdiagram",
                                    tags$br(),
                                    column(6,highchartOutput(outputId = "barPlot1", width="200%",height="450px")),
                                    # column(6,leafletOutput(outputId = "mapPlot", height=450)),
                           ),
                           tabPanel("Tabel en cijfers", 
                                    tags$br(),
                                    fluidRow(
                                      column(10,
                                             DT::dataTableOutput(outputId = "table1"), 
                                             downloadButton("downloadData", "Download")
                                      )
                                    ),
                                    tags$br(),
                                    fluidRow(
                                      column(6,p(id="disclaimtable","concept."),  tags$style(HTML("#disclaimtable{font-style: italic}")))
                                    )
                           ),
                           tabPanel("Help", 
                                    tags$br(),
                                    fluidRow(column(12
                                                    , class = "block"
                                                    , div(style = "padding-left:20px;padding-top: 15px; padding-bottom: 15px;"
                                                          , fluidRow("concept.")
                                                          , fluidRow("Heeft u vragen over dit dashboard of over andere mogelijkheden die u graag zou willen zien, neem dan contact op met: "
                                                                     , HTML("<a href='mailto:anoniem@bullshit.nl'>anoniem</a>")))
                                    )
                                    ),
                           )
               )
        ),
        column(2)
      ),
    ),
      tabPanel("M"),
      tabPanel("Help"),
      tabPanel("Toelichting"),

      tabPanel("Component 5"),
      widths = c(1,10)
    ), ## this closes the navpanel




    fluidRow(tags$br())
  )
}

# De server met interactieve input
server <- function(input, output) {

   # Data klaarmaken voor barplot

  mydata_ <- reactive({
    data_ <- df2  # 
    data_
  })

  output$my_table  <- renderDataTable({
    # Filter the data
    df__<-my_data_()
    df2__%>% filter(AanvDat >= input$dateRange[1] & AanvDat <= input$dateRange[2])
  })



  output$groups <- renderUI({
    df_ <- mydata_()
    selectInput(inputId = "grouper", label = "Group variable", choices = c("L","LV","B","Naam","Omsch", "G"), selected = "L")
  })




  summary_data_ <- reactive({
    req(input$grouper)

    mydata_() %>%
      dplyr::group_by(!!!rlang::syms(input$grouper), Q) %>%
      dplyr::summarise(aantal = n()) %>%
      dplyr::arrange(desc(aantal)) %>%
      top_n(5)
  })

  output$barPlot1 <- renderHighchart({
    data_ <- summary_data_()
    hchart(data_, "column", hcaes(x = (!!input$grouper) , y = aantal , group = Q)) %>% 
      hc_plotOptions(column = list(stacking = "normal"))
  })

  # Data klaarmaken voor tabel
  mydata <- reactive({
    data <- df2  # 
    data
  })

  # output$groups <- renderUI({
  #   df <- mydata()
  #   selectInput(inputId = "grouper", label = "Group variable", choices = c("L","LV","B","Naam","Omsch", "G"), selected = "L")
  # })

  summary_data <- reactive({
    req(input$grouper)
    mydata() %>%
      dplyr::group_by(!!!rlang::syms(input$grouper)) %>%
      dplyr::summarise(aantal = n(),
                       Q = case_when(sum(Q =="TRUE") == length(Q) ~"JA", 
                                          sum(Q == "FALSE") == length(Q) ~"Nee",
                                          TRUE ~ "Beide"),
                       min_datum = as.Date(as.character(min(AanvDat))),
                       max_datum = as.Date(as.character(max(AanvDat))),%>%



      dplyr::arrange(desc(aantal)) 
  })

  output$table1 <- DT::renderDataTable({
    DT::datatable(summary_data())
  })

  # Downloadable csv of selected dataset ----
  output$downloadData <- downloadHandler(
    filename = function() {
      paste("O",Sys.Date(),".csv", sep = "")
    },
    content = function(file) {
      write.csv2(summary_data(), file, row.names = FALSE)
      write(paste("
        Dashboard-",Sys.Date(),"
        Deze tabel is nog in de conceptfase. D"
      ),file=file,append=TRUE)
    }
  )




# END
}

# Create Shiny app ----
shinyApp(ui, server)

I hope my question is clear enough. Thanks in advance.

they want to me to add more text/details, but i dont think deleting stuff makes it better to follow.

Answer 1

I suggest using the lubridate package to work with Dates in R and Shiny