如何使用闪亮在输出数据表中保留编辑过的值

如何解决如何使用闪亮在输出数据表中保留编辑过的值

我正在构建一个闪亮的应用程序来将所有输入变量添加到数据表中。 我还有另一个按钮用于启用第二个 tabPanel 并显示一个可编辑的数据表。 我想编辑第二个 tabPanel 中的表格并更新数据表。因此，当我继续添加更多值时，它可以保留已完成的更新。

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

ui <- fluidPage(
  tabsetPanel(
    id = "idTabset",tabPanel(
      value = "input_data",title = "Inpute Data",textInput(inputId   = 'item1',label = 'Item 1'),textInput(inputId   = 'item2',label = 'Item 2'),actionButton('save_data','Add'),actionButton('review_data','Save and Review')
    ),tabPanel(
      value = "input_tbl",title = "Raw Data",DT::dataTableOutput('output_tbl'),actionButton('submit_tbl','Upload')
    )
  )
)

server <- function(input,output,session) {
  hideTab(inputId = "idTabset",target = "input_tbl")
  
  user_tbl <- tibble(`Item 1` = as.character(),`Item 2` = as.character())
  
  user_data <- reactive({
    tibble(`Item 1` = as.character(input$item1),`Item 2` = as.character(input$item2))
  })
  
  observeEvent(input$save_data,{
    user_tbl <<- user_tbl %>%
      bind_rows(user_data())
    
    output$output_tbl = DT::renderDataTable({
      DT::datatable(user_tbl,editable = TRUE)
      
    })
    
    sapply(c('item1','item2'),function(x) {updateTextInput(session,x,value = "")})
  })
  
  observeEvent(input$review_data,{
    showTab(inputId = "idTabset",target = "input_tbl")
  })
  
}

shinyApp(ui = ui,server = server)

有谁知道如何保持更新后的值？

更新：感谢@YBS

我也在外部创建 user_tbl，所以我不需要使用 reactiveValues 来分配结果。

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

user_tbl <- data.frame(`Item 1` = as.character(),`Item 2` = as.character(),stringsAsFactors = FALSE)

ui <- fluidPage(
  tabsetPanel(
    id = "idTabset",)
  )
)

server <- function(input,target = "input_tbl")
  
  user_data <- reactive({
    data.frame(`Item 1` = as.character(input$item1),`Item 2` = as.character(input$item2),stringsAsFactors = FALSE)
  })
  
  observeEvent(input$save_data,{
    user_tbl <<- user_tbl %>%
      bind_rows(user_data())
    
    output$output_tbl <- DT::renderDataTable({
      DT::datatable(user_tbl,value = "")})
  })
  
  observeEvent(input$output_tbl_cell_edit,{
    info = input$output_tbl_cell_edit
    i = info$row
    j = info$col
    v = info$value
    user_tbl[i,j] <<- DT::coerceValue(v,user_tbl[i,j])
    
  })
  
  observeEvent(input$review_data,server = server)

谢谢。

解决方法

也许您正在寻找 table_cell_edit 的 DT 功能。您需要一个 reactiveValues 对象来跟踪 tab1 和 tab2 中的更改。试试这个

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

ui <- fluidPage(
  tabsetPanel(
    id = "idTabset",tabPanel(
      value = "input_data",title = "Inpute Data",textInput(inputId   = 'item1',label = 'Item 1'),textInput(inputId   = 'item2',label = 'Item 2'),actionButton('save_data','Add'),actionButton('review_data','Save and Review')
    ),tabPanel(
      value = "input_tbl",title = "Raw Data",DT::dataTableOutput('output_tbl'),actionButton('submit_tbl','Upload')
    )
  )
)

server <- function(input,output,session) {
  hideTab(inputId = "idTabset",target = "input_tbl")
  
  user_tbl <- tibble(`Item 1` = as.character(),`Item 2` = as.character())
  
  rv <- reactiveValues(data=user_tbl)
  
  user_data <- reactive({
    tibble(`Item 1` = as.character(input$item1),`Item 2` = as.character(input$item2))
  })
  
  observeEvent(input$save_data,{
    rv$data <<- rv$data %>%
      bind_rows(user_data())
    output$output_tbl = DT::renderDataTable({
      DT::datatable(rv$data,editable = TRUE)
      
    })
    
    sapply(c('item1','item2'),function(x) {updateTextInput(session,x,value = "")})
  })
  
  observeEvent(input$output_tbl_cell_edit,{
    info = input$output_tbl_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value

    rv$data[i,j] <<- DT::coerceValue(v,rv$data[i,j])

  })
  
  observeEvent(input$review_data,{
    showTab(inputId = "idTabset",target = "input_tbl")
  })
  
}

shinyApp(ui = ui,server = server)