Shiny可编辑DT Table实现dateInput输入与risk下拉选择功能

我有一个包含date_time、risk两行的表格，想要在Shiny的输出表格中支持用户直接编辑，具体要求如下：

• date_time行可直接通过dateInput()输入日期
• risk行可通过下拉列表选择，可选值为c('high', 'medium', 'low')
  请问这个需求是否可以实现？非常感谢各位的帮助。

初始待调试代码：

library(tidyverse)
library(shiny)
library(DT)

mydata = data.frame(
  date_time = as.Date(c('30-12-2000', '30-12-1999', '30-12-1998'), format = '%d-%m-%Y'),
  risk = c('high', 'medium', 'low')
)

mydata_t <- t(mydata)

ui <- fluidPage(
  DTOutput(outputId = "final_tbl")
)

server <- function(input, output){
  df1 <- reactiveValues(data=NULL)
  dat <- reactive({
    mydata_t
  })
  
  observe({
    df1$data <- dat()
  })
  
  output$final_tbl <- renderDT({
    df1$data %>%
      datatable(editable = list(target = "cell", disable = list(columns = c(0))), options = list(paging = FALSE, searching = FALSE))
  })
  
  observeEvent(input$final_tbl_cell_edit, {
    info = input$final_tbl_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    
    df1$data[i, j] <<- (DT::coerceValue(v, df1$data[i, j]))
    ## 此处逻辑待补充
  })
}

shinyApp(ui, server)

功能实现更新 #

参考相关示例修改后代码已可正常运行，最终可运行代码如下：

library(shiny)
library(DT)
library(dplyr)

data = data.frame(
  Observation = c('A', 'B', 'C', 'D', 'E', 'F', 'G')
)

if (interactive()) {
  ui <- fluidPage(
    DT::dataTableOutput('interface_table'),
    br(),
    actionButton("do", "应用修改"),
    br(),
    hr(),
    tabsetPanel(
      tabPanel("原始数据", DT::dataTableOutput('contents')),
      tabPanel("编辑后数据", DT::dataTableOutput('it_contents'))
    ),
    br()    
  )
  
  server <- function(input, output, session) {
    
    output$contents <- DT::renderDataTable(
      data)
    
  
  # 批量生成Shiny输入控件的字符向量
  shinyInput <- function(FUN, len, id, ...) {
    inputs <- numeric(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
    }
    inputs
  }
  
  # 批量获取输入控件的值
  shinyValue <- function(id, len) {
    unlist(lapply(seq_len(len), function(i) {
      value <- input[[paste0(id, i)]]
      if (is.null(value)) NA else value
    }))
  }
  
  
  it_df <- reactive({
    data.frame(
      Observation = c('A', 'B', 'C', 'D', 'E', 'F', 'G'),
      date_time = shinyInput(textInput, nrow(data),
                        "date1", value = NULL, width = "150px", placeholder = 'yyyy-mm-dd'),
      risk = shinyInput(selectInput, nrow(data),
                        'select_risk', choices = c('high', 'medium', 'low' ), width = "100px"),
      Nmonth = shinyInput(numericInput, nrow(data),
                        'number_month', value = 12,
                        width = '100%', min = 0, max = 12),
      stringsAsFactors = FALSE
    )
  })
  
  
  output$interface_table <- DT::renderDataTable(
    it_df(), rownames = FALSE, escape = FALSE, options = list(
      autoWidth = TRUE, scrollX = TRUE,
      dom = 't', ordering = FALSE,
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
  )
  
  it_data <- reactive({
    if (input$do > 0) {
      dat <- data.frame(
        Observation = c('A', 'B', 'C', 'D', 'E', 'F', 'G'),
        year = substr(shinyValue('date1', nrow(data)), start = 1, stop = 4),
        date_time=shinyValue('date1', nrow(data)),
        risk = shinyValue('select_risk', nrow(data)),
        Nmonth = shinyValue('number_month', nrow(data)),
        weight = (12/ shinyValue('number_month', nrow(data)))
      )
      return(dat)
    }
    else { return() }
  })
  
  output$it_contents <- DT::renderDataTable(
    it_data(),  options = list( dom = 't', ordering = FALSE),
    rownames = TRUE, selection = 'none')
  }
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Reza AM