Change the selectInput to a dateInput in Shiny

Question

I made an app that is triggered when I use a database by fileInput. The database is this df that I inserted below, but it is in excel format. This base that is in excel I insert in fileInput.

df <- structure(
   list(date = c("2021-01-01","2021-01-02","2021-01-03","2021-01-04","2021-01-05"),
         d1 = c(0,1,4,5,6), d2 = c(2,4,5,6,7)),class = "data.frame", row.names = c(NA, -5L))
}

However, would I like to change the selectInput() that refers dates to a dateInput()? Also, I would like the dates to be presented in day-month-year style.

library(shiny)
library(shinythemes)
library(openxlsx)
library(shinyBS)
library(shinyWidgets)
library(openxlsx)
library(writexl)
library(readxl)


ui <- fluidPage(
  
  ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                          br(),
                          
                          tabPanel("",
                                   fileInput("file", "Please upload a file", accept = c(".xlsx")),
                                   sidebarLayout(
                                     sidebarPanel(
                                       
                                       selectInput("date", label = h4("Date"),""),
                                       selectInput("d1", label = h4("D1"),""),
                                       selectInput("d2", label = h4("D2"),""),
                                       br(),
                                       
                                     ),
                                     
                                     mainPanel( 
                                     ))
                          )))


server <- function(input, output, session) {
  df1 <- reactiveValues(dat=NULL)
  
  data <- eventReactive(input$file, {
    if (is.null(input$file)) return(NULL)
    df <- read_excel(input$file$datapath)
    df
  })
  
  observe({
    df1$dat <- data()
  })
  
  observeEvent(input$file, {
    
    if (!is.null(df1$dat)) {
      data <- df1$dat
      updateSelectInput(session, "date", label = "Date", unique(data$Date))
      updateSelectInput(session, "d1", label = "D1", unique(data$D1))
      updateSelectInput(session, "d2", label = "D2", unique(data$D2))
    }
    
  })
  
}

shinyApp(ui = ui, server = server)

Ronak Shah · Answer 1 · 2021-08-09T04:48:01.233

You can change the selectInput code for date to dateInput

dateInput("date", label = h4("Date"),"", format = 'dd-mm-yyyy'),

and in observeEvent change updateSelectInput to updateDateInput

updateDateInput(session, "date", label = "Date", min = min(data$date), max = max(data$date))

Note that data$date should be of class Date, run data$date <- as.Date(data$date) to do that.

For testing I wrote the data shared to an excel file called file.xlsx using writexl::write_xlsx(df, 'file.xlsx').

Complete app code -

library(readxl)
library(shiny)

ui <- fluidPage(
  
  ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                          br(),
                          
                          tabPanel("",
                                   fileInput("file", "Please upload a file", accept = c(".xlsx")),
                                   sidebarLayout(
                                     sidebarPanel(
                                       
                                       dateInput("date", label = h4("Date"),"", format = 'dd-mm-yyyy'),
                                       selectInput("d1", label = h4("D1"),""),
                                       selectInput("d2", label = h4("D2"),""),
                                       br(),
                                       
                                     ),
                                     
                                     mainPanel( 
                                     ))
                          )))


server <- function(input, output, session) {
  
  data1 <- eventReactive(input$file, {
    if (is.null(input$file)) return(NULL)
    df <- read_excel(input$file$datapath)
    df
  })

  
  observeEvent(input$file, {
    
      req(data1)
      data <- data1()
      data$date <- as.Date(data$date)
      updateDateInput(session, "date", label = "Date", min = min(data$date), max = max(data$date))
      updateSelectInput(session, "d1", label = "D1", unique(data$d1))
      updateSelectInput(session, "d2", label = "D2", unique(data$d2))
    
  })
  
}

shinyApp(ui = ui, server = server)

Thanks for reply! I made adjustments as suggested. But I didn't quite understand this part ``data$date <- as.Date(data$date)`` Where do I make this adjustment? Could you show in the code? Thank you again! — Antonio, Aug 09 '21 at 04:14
Basically, the date column should be of Date class. You can include it after `data <- df1$dat` and before `updateDateInput` in `observeEvent`. — Ronak Shah, Aug 09 '21 at 04:20
Thanks Ronak for the suggestion you provided, but it still didn't work out very well for my case, anyway I really appreciate your help! :) — Antonio, Aug 09 '21 at 14:28

score 1 · Accepted Answer · answered Aug 09 '21 at 05:15

Following on from your other question, this is fairly straight-forward as long as your input file is consistently named and arranged (though this shouldn't be assumed, and you would be wise to check this on input of a data set - do this in the else statement of the data eventReactive()).

Assuming you also want only the values that are present in your data set to be available, here is the full code edited from my answer to your other question that should enable you to use the dateInput() input type with arbitrary dates from the input file.

The other thing to notice is that because the UI component is generated in the server after the data is uploaded, there would normally not be a date picker field, because it has not been generated yet. So I have added a dummy date picker field which will update when someone uploads a file. This is mainly just for UI consistency, so that it doesn't suddenly appear when someone uploads a file, and is otherwise not there.

library(shiny)
library(shinythemes)
library(openxlsx)
library(shinyBS)
library(shinyWidgets)
library(openxlsx)
library(writexl)
library(readxl)
library(DT)

ui <- fluidPage(
    
    ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                            br(),
                            
                            tabPanel("",
                                     fileInput("file", "Please upload a file", accept = c(".xlsx")),
                                     sidebarLayout(
                                         sidebarPanel(
                                             
                                             uiOutput("date"),
                                             selectInput("d1", label = h4("D1"),""),
                                             selectInput("d2", label = h4("D2"),""),
                                             br(),
                                             
                                         ),
                                         
                                         mainPanel( 
                                         ))
                            )))


server <- function(input, output, session) {
    data <- eventReactive(input$file, {
        if (is.null(input$file)) {
            return(NULL)
        }
        else {
            df <- read_excel(input$file$datapath)
            return(df)
        }
    })
    
    output$date <- renderUI({
        if (!is.null(input$file)) {
            
            all_dates <- seq(as.Date(min(data()$date)), as.Date(max(data()$date)), by = "day")
            disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
            
            dateInput(input = "date", 
                      label = "Select Date",
                      min = min(data()$date),
                      max = max(data()$date),
                      value = max(data()$date),
                      format = "dd-mm-yyyy",
                      datesdisabled = disabled)
        }
        else {
            dateInput(input = "date", 
                      label = "Select Date",
                      min = min("1970-01-01"),
                      max = max(Sys.Date()),
                      format = "dd-mm-yyyy")
        }
    })
    
    observeEvent(input$file, {
        
        req(data)
        data <- data()
        data$date <- as.Date(data$date)
        print(data)
        updateSelectInput(session, "d1", label = "D1", unique(data$d1))
        updateSelectInput(session, "d2", label = "D2", unique(data$d2))
    })
}

shinyApp(ui = ui, server = server)

No problem, glad I could help :) – Sam Rogers Aug 09 '21 at 22:50 — Sam Rogers, Aug 09 '21 at 22:50

Change the selectInput to a dateInput in Shiny

2 Answers2

Linked