CODEWITHSUNDEEP
rshiny
Antonio
Antonio

Reputation: 1111

Adjust output for dates in Shiny

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)

Upvotes: 2

Views: 757

Answers (1)

Sam Rogers
Sam Rogers

Reputation: 797

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)

Upvotes: 1

Related Questions