日期輸入 DT R shiny

Question

這是我的代碼。 一切正常。
DateInput 在 DT 中不可見。 基本上我想得到一些物品，其中兩個是日期。 日期輸入正在工作，但是當我按下提交時，只有月份數據而不是日期。 同樣當我 select 一行並按刪除該行被刪除。 這可以。 但是當我 select a Row 並錯誤地按下提交時，應用程序崩潰了。

我有以下查詢 1. 為什么日期輸入不起作用 2. 為什么我的應用程序在選擇一行后按提交時崩潰

library(shiny)
library(shinyjs)
library(shinythemes)
library(DT)

GetMCATableMetadata <- function() {
  fields <- c(
    id = "Id",
    month = "Month of Account",
    due_date = "Due Date of Submission",
    actual_date = "Actual Date of Submission"
  )

  result <- list(fields = fields)
  return (result)
}


########################## CREATE, READ, UPDATE, DELETE #######################################
#### CRUD



# Find the next ID of a new record
GetMCANextId <- function() {
  if (exists("mcaresponses") && nrow(mcaresponses) > 0) {
    max(as.integer(rownames(mcaresponses))) + 1
  } else {
    return (1)
  }
}

#C
CreateData <- function(data) {
  data <- CastData(data)
  rownames(data) <- GetMCANextId()
  if (exists("mcaresponses")) {
    mcaresponses <<- rbind(mcaresponses, data)
  } else {
    mcaresponses <<- data
  }
}

#R
ReadData <- function() {
  if (exists("mcaresponses")) {
    mcaresponses
  }
}

#U
UpdateData <- function(data) {
  data <- CastData(data)
  mcaresponses[row.names(mcaresponses) == row.names(data),] <<- data
}

#D
DeleteData <- function(data) {
  mcaresponses <<-
    mcaresponses[row.names(mcaresponses) != unname(data["id"]),]
}

#######################################################################################
# Cast from Inputs to a one-row data.frame

CastData <- function(data) {
  datar <- data.frame(
    month = data["month"],
    due_date = as.Date(data[["due_date"]],"dd-mm-yyyy"),
    actual_date = as.Date(data[["actual_date"]],"dd-mm-yyyy")
  )

  rownames(datar) <- data["id"]
  return (datar)
}




# Return an empty, new record
CreateDefaultRecord <- function() {
  mydefault <-
    CastData(list(
      id = "0",
      month = "", 
      due_date ="",
      actual_date=""

    ))
  return (mydefault)
}

# Fill the input fields with the values of the selected record in the table
UpdateInputs <- function(data, session) {
  updateTextInput(session, "id", value = unname(rownames(data)))
  updateTextInput(session, "month", value = unname(data["month"]))
  updateDateInput(session, "due_date", value = as.Date(data[["due_date"]],"dd-mm-yyyy"))
  updateDateInput(session, "actual_date",value=as.Date(data[["actual_date"]],"dd-mm-yyyy"))

}



ui <- fluidPage(
  #use shiny js to disable the ID field
  shinyjs::useShinyjs(),
  ##
  #data table
  DT::dataTableOutput("mcaresponses", width = 800),

  #input fields
  tags$hr(),
  shinyjs::disabled(textInput("id", "Id", "0")),
  textInput("month", "Month of Account", ""),
  dateInput("due_date", label="Due Date of Submission", format="dd-mm-yyyy"),
  dateInput("actual_date", label="Actual Date of Submission", format="dd-mm-yyyy"),
  #action buttons
  actionButton("submit", "Submit"),
  actionButton("new", "New"),
  actionButton("delete", "Delete")
)



server <- function(input, output, session) {
  # input fields are treated as a group
  formData <- reactive({
    sapply(names(GetMCATableMetadata()$fields), function(x)
      input[[x]])
  })

  # Click "Submit" button -> save data
  observeEvent(input$submit, {
    if (input$id != "0") {
      UpdateData(formData())
    } else {
      CreateData(formData())
      UpdateInputs(CreateDefaultRecord(), session)
    }
  }, priority = 1)

  # Press "New" button -> display empty record
  observeEvent(input$new, {
    UpdateInputs(CreateDefaultRecord(), session)
  })

  # Press "Delete" button -> delete from data
  observeEvent(input$delete, {
    DeleteData(formData())
    UpdateInputs(CreateDefaultRecord(), session)
  }, priority = 1)

  # Select row in table -> show details in inputs
  observeEvent(input$mcaresponses_rows_selected, {
    if (length(input$mcaresponses_rows_selected) > 0) {
      data <- ReadData()[input$mcaresponses_rows_selected,]
      UpdateInputs(data, session)
    }

  })

  # display table
  output$mcaresponses <- DT::renderDataTable({
    #update after submit is clicked
    input$submit
    #update after delete is clicked
    input$delete
    ReadData()
    }, server = FALSE, selection = "single",
  colnames = unname(GetMCATableMetadata()$fields)[-1])

}

shinyApp(ui = ui, server = server)

Answer 1

我認為這里的大部分挑戰是日期格式。 你打電話時：

sapply(names(GetMCATableMetadata()$fields), function(x) input[[x]])

存儲的值是數值（在字符串中）。

您可以將其轉換為CastData中的日期：

due_date = as.Date(as.numeric(data["due_date"]), origin = "1970-01-01"),
actual_date = as.Date(as.numeric(data["actual_date"]), origin = "1970-01-01")

當您更新DateInput和actual_date的due_date ，您已經有了Date格式：

updateDateInput(session, "due_date", value = data[["due_date"]], "dd-mm-yyyy")
updateDateInput(session, "actual_date", value = data[["actual_date"]],"dd-mm-yyyy")

可能有一些替代方法，但這似乎適用於當前設置來創建、select 行和刪除。 讓我知道這是否適合您。