Adjust output for dates in Shiny

Question

The APP below is working normally. However, I would like the output values in relation to the dates to be different, that is, instead of coming out 2021-01-01 I would like them to come out like this: 01-01-2021. Obviously, without changing the df database directly and yes on the output.

Thank you very much!

library(shiny)
library(shinythemes)

function.cl<-function(df,date, d1,d2){
  
  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))
}    
ui <- fluidPage(
  
  ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                          br(),
                          
                          tabPanel("",
                                     sidebarLayout(
                                     sidebarPanel(
                                       
                                       selectInput("date", label = h4("Date"),""),
                                       selectInput("d1", label = h4("D1"),""),
                                       selectInput("d2", label = h4("D2"),""),
                                       br(),
                                       actionButton("reset", "Reset"),
                                     ),
                                     
                                     mainPanel(
                                     ))
                          )))


server <- function(input, output,session) {
  data <- reactive(function.cl())
  
  observe({
    updateSelectInput(session, "date",labe ="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)

#NEW CODE

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(
                                       
                                       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)

Sam Rogers · Accepted Answer · 2021-08-09T01:05:02.450

Why don't you use the dateInput() input type, instead of selectInput()?

If you only want particular dates to be eligible for selection, you can disable other dates within dateInput(). However, this becomes slightly more complex, as you aren't able to update the datesdisabled argument with the updateDateInput() function, isabled I am assuming you are wanting US style day-month-year format, but if not, you can edit the format.

For example:

library(shiny)
library(shinythemes)

function.cl<-function(df,date, d1,d2){
    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))
}    
ui <- fluidPage(
    
    ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                            br(),
                            
                            tabPanel("",
                                     sidebarLayout(
                                         sidebarPanel(
                                             
                                             uiOutput("date"),
                                             selectInput("d1", label = h4("D1"),""),
                                             selectInput("d2", label = h4("D2"),""),
                                             br(),
                                             actionButton("reset", "Reset"),
                                         ),
                                         
                                         mainPanel(
                                         ))
                            )))


server <- function(input, output,session) {
    data <- reactive(function.cl())
      
    output$date <- renderUI({
        all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), 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)
    })

    observe({
        updateSelectInput(session, "d1", label = "D1", unique(data()$d1))
        updateSelectInput(session, "d2", label = "D2", unique(data()$d2))
    })
}

shinyApp(ui = ui, server = server)

Edit: Alternatively, you have just defined the dates above as strings, so you can just reformat the strings.

I.e. the function where you define your data can just be changed:

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

If you really want to use the selectInput() function and you really want the dates as Date types rather than characters, you could also just format back and forth between strings and dates.

For example:

library(shiny)
library(shinythemes)

function.cl<-function(df,date, d1,d2){
    
    df <- structure(
        list(date = as.Date(c("01-01-2021","01-02-2021","01-03-2021","01-03-2021","01-05-2021"), format = "%m-%d-%Y"),
             d1 = c(0,1,4,5,6), d2 = c(2,4,5,6,7)),class = "data.frame", row.names = c(NA, -5L))
}    
ui <- fluidPage(
    
    ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                            br(),
                            
                            tabPanel("",
                                     sidebarLayout(
                                         sidebarPanel(
                                             
                                             selectInput("date", label = h4("Date"),""),
                                             selectInput("d1", label = h4("D1"),""),
                                             selectInput("d2", label = h4("D2"),""),
                                             br(),
                                             actionButton("reset", "Reset"),
                                         ),
                                         
                                         mainPanel(
                                         ))
                            )))


server <- function(input, output,session) {
    data <- reactive(function.cl())
    
    observe({
        updateSelectInput(session, "date",labe ="Date", unique(format(data()$date, format = "%m-%d-%Y")))
        updateSelectInput(session, "d1", label = "D1", unique(data()$d1))
        updateSelectInput(session, "d2", label = "D2", unique(data()$d2))
    })    
}

shinyApp(ui = ui, server = server)

I liked this first way you did it, using dateInput(). It got better. But I would like some help with this new form you provided. I have a case where the database is being inserted by fileInput and I am not setting the df in the code. I'm going to put this new code which is similar above for you to see. I would just like your help regarding how it would look in this code using dateInput(). — Antonio, Aug 09 '21 at 01:45
Why don't you mark this as accepted then, and/or upvote and post a new question with your new problem. If you link it here after you post it, I will see if I can answer if for you — Sam Rogers, Aug 09 '21 at 02:51
Sorry for any inconvenience. I asked a new question, if you can take a look I would appreciate it. https://stackoverflow.com/questions/68706475/change-the-selectinput-to-a-dateinput-in-shiny — Antonio, Aug 09 '21 at 03:21
No problem at all. I'll have a look at your other question when I get a minute :) — Sam Rogers, Aug 09 '21 at 03:44
Sorry, I didn't notice that you had updated your code above. I will update my answer, and answer in the other question as well, just for clarity :) — Sam Rogers, Aug 09 '21 at 04:47
Hi Sam Rogers! Could you take a look at this question? https://stackoverflow.com/questions/68807752/how-do-i-insert-days-that-are-holidays-into-a-shiny-app Thank you very much! — Antonio, Aug 17 '21 at 01:18
Hi Sam Rogers! Sorry to ask you to see another question. But I remembered that I saw on your profile that you are a statistician and a programmer so I think you can help. My brother Antonio asked the question, we are working on the problem together. If you can take a look, I appreciate it. Any help is appreciated. https://stackoverflow.com/questions/68840372/forecasting-analysis-in-r — Antonio, Aug 19 '21 at 00:12

Adjust output for dates in Shiny

1 Answers1

Linked