Как добавить фильтр даты в R Shiny? - PullRequest
0 голосов
/ 04 апреля 2020

Может кто-нибудь помочь мне, я застрял на том, как фильтровать по дате? Я понятия не имею, как это реализовать.

И я не понимаю, как расположить две скважинные панели рядом друг с другом. Что бы я ни пытался, это выглядело ужасно.

С уважением!

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)


Надеюсь, мой вопрос достаточно ясен! Заранее спасибо.

они хотят, чтобы я добавил больше текста / подробностей, но я не думаю, что удаление материала делает его лучше следовать.

1 Ответ

0 голосов
/ 05 апреля 2020

Я предлагаю использовать пакет lubridate для работы с датами в R и Shiny

...