Настройте вывод дат в Shiny

avatar
Antonio
8 августа 2021 в 23:57
95
1
2

Приложение ниже работает нормально. Однако я хотел бы, чтобы выходные значения по отношению к датам были другими, то есть вместо 2021-01-01 я хотел бы, чтобы они выходили так: 01-01-2021. Очевидно, без изменения df database напрямую и да на выходе.

Большое спасибо!

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)

#НОВЫЙ КОД

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)
Источник

Ответы (1)

avatar
Sam Rogers
9 августа 2021 в 00:53
1

Почему бы вам не использовать dateInput() тип ввода вместо selectInput()?

Если вы хотите, чтобы для выбора были доступны только определенные даты, вы можете отключить другие даты в пределах dateInput(). Однако это становится немного более сложным, так как вы не можете обновить аргумент datesdisabled с помощью функции updateDateInput(), которая включена. Я предполагаю, что вам нужен формат day-month-year в американском стиле, но если нет, вы можете редактировать формат.

Например:

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)

Редактировать: Кроме того, вы только что определили даты выше как строки, поэтому вы можете просто переформатировать строки.

Т.е. функцию, в которой вы определяете свои данные, можно просто изменить:

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

Если вы действительно хотите использовать функцию selectInput(), и, вам действительно нужны даты как типы Date, а не символы, вы также можете просто форматировать между строками и датами.

Например:

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)
Antonio
9 августа 2021 в 01:45
0

Мне понравился первый способ, которым вы это сделали, используя dateInput(). Стало лучше. Но мне нужна помощь с этой новой формой, которую вы предоставили. У меня есть случай, когда база данных вставляется с помощью fileInput, и я не устанавливаю df в коде. Я собираюсь поместить этот новый код, который похож на приведенный выше, чтобы вы могли его увидеть. Мне просто нужна ваша помощь относительно того, как это будет выглядеть в этом коде с использованием dateInput().

Sam Rogers
9 августа 2021 в 02:51
0

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

Antonio
9 августа 2021 в 03:21
0

Приносим извинения за неудобства. Я задал новый вопрос, если вы можете взглянуть, я был бы признателен. coderhelper.com/questions/68706475/…

Sam Rogers
9 августа 2021 в 03:44
0

Совершенно никаких проблем. Я посмотрю на ваш другой вопрос, когда у меня будет минутка :)

Sam Rogers
9 августа 2021 в 04:47
0

Извините, я не заметил, что вы обновили свой код выше. Я обновлю свой ответ, а также отвечу на другой вопрос, просто для ясности :)

Antonio
17 августа 2021 в 01:18
0

Привет, Сэм Роджерс! Не могли бы вы взглянуть на этот вопрос? coderhelper.com/questions/68807752/… Большое спасибо!

Sam Rogers
17 августа 2021 в 01:30
0

Конечно, сейчас посмотрю

Antonio
19 августа 2021 в 00:12
0

Привет, Сэм Роджерс! Извините, что прошу вас увидеть еще один вопрос. Но я вспомнил, что видел в вашем профиле, что вы статистик и программист, поэтому я думаю, что вы можете помочь. Мой брат Антонио задал вопрос, мы вместе работаем над проблемой. Если вы можете взглянуть, я ценю это. Любая помощь приветствуется. coderhelper.com/questions/68840372/forecasting-analysis-in-r