функция as.Date не работает в таблице данных - PullRequest
Новая
       6

функция as.Date не работает в таблице данных

0 голосов
/ 13 октября 2019

Я использую экран ввода данных, где есть три dateInput. Я хочу показать месяц в формате «Месяц, ГГГГ». Я использовал много разных форматов, но не смог достичь того, что задумал. Мне нужны следующие столбцы в следующем формате: 1. Месяц: январь 2019 г. 2. Срок оплаты: дд-мм-гггг 3. Фактическая дата: дд-мм-гггг

Как этого добиться?

Я прилагаю мой код ниже 

fields <- c("Financial_Year","Quarter","Month", "Due_Date","Actual_Date")
library(shiny)
library(lubridate)
library(DT)

ui<-fluidPage(
  titlePanel("Monthly Civil Accounts"),
  sidebarLayout(
    sidebarPanel(width=3,
                 textInput("Financial_Year","Financial Year"),
                 selectInput("Quarter","Quarter",c("Q1","Q2","Q3","Q4")),
                 dateInput("Month","Month of Account", format="MM, yyyy"),
                 dateInput("Due_Date", "Due date for submission", format="dd-mm-yyyy"),
                 dateInput("Actual_Date","Actual date of submission",format="dd-mm-yyyy"),
                 actionButton("save","Add",icon=icon("plus-square")),
                 actionButton("reset","Delete",icon=icon("minus-square"))
    ),
    mainPanel(
      mainPanel(
        DT::dataTableOutput("responses1", width = 600), tags$hr()
      ))))

server<-function(input,output,session){
  saveData <- function(data) {
    data <- data.frame(
      Financial_Year=data["Financial_Year"],
      Quarter=data["Quarter"],
      Month=as.Date(as.numeric(data[["Month"]]),"1970-01-01"),
      Due_Date=as.Date(as.numeric(data[["Due_Date"]]),"1970-01-01"),
      Actual_Date=as.Date(as.numeric(data[["Actual_Date"]]),"1970-01-01")
    )
    if (exists("responses")) {
      responses <<- rbind(responses, data)
    } else {
      responses <<- data
    }
  }
  mcaloadData <- function() {
    if (exists("responses")) {
      responses
    }
  }
  formData <- reactive({
    data <- sapply(fields, function(x) input[[x]])
    data
    #print(data)
  })
  observeEvent(input$save, {
    saveData(formData())
  })

  output$responses1 <- DT::renderDataTable({
    input$save
    input$reset
    #mcadata<-transform(mcaloadData(), Delay=as.numeric((mcaloadData()$Actual_Date)-(mcaloadData()$Due_Date)))
    datatable(mcaloadData(),rownames=FALSE,options = list(ordering=FALSE, searching=FALSE,paging=FALSE,pageLength=FALSE,info=FALSE))
  })
}
shinyApp(ui,server)

Любая помощь, пожалуйста !!

Ответы [ 2 ]

0 голосов
/ 16 октября 2019

Это работает для меня. 

library(shiny)
library(DT)

ui <- fluidPage(

  titlePanel("DT")

  ,sidebarLayout(
    sidebarPanel(

      width = 2

      ,textInput(
        inputId = "Financial_Year"
        ,label = "Financial Year"
        )

      ,selectInput(
        inputId = "Quarter"
        ,label = "Quarter"
        ,c("Q1","Q2","Q3","Q4")
        )

      ,dateInput(
        inputId = "Month"
        ,label = "Month of Account"
        ,format = "MM, yyyy"
        )

      ,dateInput(
        inputId = "Due_Date"
        ,label = "Due date for submission"
        ,format = "dd-mm-yyyy"
        )

      ,dateInput(
        inputId = "Actual_Date"
        ,label = "Actual date of submission"
        ,format = "dd-mm-yyyy"
        )

      ,actionButton(
        inputId = "save"
        ,label = "Add"
        ,icon = icon("plus-square")
        )

      ,actionButton(
        inputId = "reset"
        ,label = "Delete"
        ,icon = icon("minus-square")
        )
    )

    ,mainPanel(
      DT::dataTableOutput("dt", width = 600)
    )

  )
)

server <- function(input, output, session) {

  observeEvent(input$save,{

    df <- data.frame(
      Fin_year = input$Financial_Year
      ,Quarter = input$Quarter
      ,Mth = format(input$Month, "%B, %Y")
      ,Due_Date = format(input$Due_Date, "%d-%m-%Y")
      ,Actual_Date = format(input$Actual_Date, "%d-%m-%Y")
    )

    if (exists("responses")) {
      responses <<- rbind(responses, df)
    } else {
      responses <<- df
    }

  })

  output$dt <- DT::renderDataTable({

    input$save

    if (exists("responses")) {

      DT::datatable(responses
        ,rownames = FALSE
        ,options = list(
          ordering = FALSE
          ,searching = FALSE
          ,paging = FALSE
          ,pageLength = FALSE
          ,info = FALSE
          )
        )
    }

  })

}

shinyApp(ui,server)
0 голосов
/ 13 октября 2019

Один из подходов - использовать formatDate с datatable. Я включил in-TG для Теланганы, Индия для локали. Я надеюсь, что это может быть полезно. 

datatable(mcaloadData(),rownames=FALSE,options = list(ordering=FALSE, searching=FALSE,paging=FALSE,pageLength=FALSE,info=FALSE)) %>%
      formatDate(c('Actual_Date', 'Due_Date'), method = 'toLocaleDateString', params = list('in-TG')) %>% 
      formatDate('Month', method = 'toLocaleDateString', params = list('in-TG', list(year = 'numeric', month = 'long')))
...