根据用户输入更新数据表，包括相应列的更新，而不仅仅是已编辑的列

Question

下面的小应用程序生成一个 DT::datatable，其中包含两列 x,y。 X 开始是一个带有 rnorm 的随机数。 y 应该是 x 加 1 的任何值。

该应用允许用户编辑 DT::datatable 中的 x 列。我已经构建了它，以便用户可以修改 x 列，但是，y 列没有按预期更新，它只是保持不变。

闪亮的代码：

library(shiny)
library(tidyverse)
library(shinydashboard)
library(scales)
library(DT)


# define functions

## generate example data
create_sample_df <- function(x) {
    data.frame(
        x = x %>% unlist
    ) %>% mutate(y = x + 1)
}

## render DT
render_dt = function(data, editable = 'cell', server = TRUE, ...) {
    renderDT(data, selection = 'none', server = server, editable = editable, ...)
}


# UI ----

header <- dashboardHeader(title = 'blah')
sidebar <- dashboardSidebar()
body <- dashboardBody(DT::DTOutput('ex_df'))
ui <- dashboardPage(header, sidebar, body)

# Server ----
server <- function(input, output) {
    
    x <- rnorm(10, 0, 2) %>% as.integer %>%  as.list
    
    # the df to be displayed as a DT::datatable. 
    ex_df <- reactive({create_sample_df(x)})
    
    ## set to initially be the on open result of ex_df, before any user input
    reactivs <- reactiveValues(ex_df = ex_df)
    
    observeEvent(input$ex_df_cell_edit, {
        info = input$ex_df_cell_edit
        str(info)
        i = info$row
        j = info$col
        v = info$value

        # update budgets, which in turn is used to generate data during create_sample_df()
        x[[i]] <<- v
        
        # now update the reactive values object with the newly generated df
        reactivs$ex_df <<- reactive({create_sample_df(x)})
    })
    
    output$ex_df <- render_dt(data = reactivs$ex_df(),
                              rownames = FALSE,
                              list(target = 'cell', 
                                   disable = list(columns = c(1))))
    
}

shinyApp(ui, server)

屏幕截图：

在屏幕上，我将 x 列中的第一行从 -1 编辑为 10。按回车后，期望的结果是第 1 行的 x 值为 10，y 值为 11。

目前这不会发生，无论如何 y 保持不变。此外，第一次尝试编辑 x 列不起作用，只有在第二次尝试后新值才会保留。

Answer 1

问题在于如何将反应数据传递给自定义render_dt。我不完全确定原因，但无法识别对 reactivs$ex_df 的更改。您在 x 列中看到的更改不是由于更新了ex_df，而是直接在表中进行的更改。因此，我将其改回直接使用renderDT。我做了一些额外的更改：

• ex_df 本身没有反应。它存储在 reactiveValues 对象中，其中每个条目本身都已经是响应式的。
• 分配给reactiveValues 不需要<<-
• cell_edit 中的编辑值是一个字符向量

library(shiny)
library(tidyverse)
library(shinydashboard)
library(scales)
library(DT)


# define functions

## generate example data
create_sample_df <- function(x) {
  data.frame(
    x = x %>% unlist
  ) %>% mutate(y = x + 1)
}


# UI ----

header <- dashboardHeader(title = 'blah')
sidebar <- dashboardSidebar()
body <- dashboardBody(DT::DTOutput('ex_df'))
ui <- dashboardPage(header, sidebar, body)

# Server ----
server <- function(input, output) {
  
  x <- rnorm(10, 0, 2) %>% as.integer %>%  as.list
  
  # the df to be displayed as a DT::datatable. 
  ex_df <- create_sample_df(x)
  
  ## set to initially be the on open result of ex_df, before any user input
  reactivs <- reactiveValues(ex_df = ex_df)
  
  observeEvent(input$ex_df_cell_edit, {
    info = input$ex_df_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    
    # update budgets, which in turn is used to generate data during create_sample_df()
    x[[i]] <<- as.numeric(v)
    
    # now update the reactive values object with the newly generated df
    reactivs$ex_df <- create_sample_df(x)
  })
  
  output$ex_df <- renderDT({
    datatable(reactivs$ex_df,
              editable = "cell",
              rownames = FALSE,
              options = list(target = 'cell', 
                             disable = list(columns = c(1))))
  })
  
}

shinyApp(ui, server)

---

编辑

这里的解决方案没有observeEvent，只有reactive() 用于ex_df。然后您可以将未评估的reactive 传递给您的render_dt 函数：

library(shiny)
library(tidyverse)
library(shinydashboard)
library(scales)
library(DT)


# define functions

## generate example data
create_sample_df <- function(x) {
  data.frame(
    x = x %>% unlist
  ) %>% mutate(y = x + 1)
}

## render DT
render_dt = function(data_in, editable = 'cell', server = TRUE, ...) {
  renderDT(data_in(), selection = 'none', server = server, editable = editable, ...)
}


# UI ----

header <- dashboardHeader(title = 'blah')
sidebar <- dashboardSidebar()
body <- dashboardBody(DT::DTOutput('ex_df'))
ui <- dashboardPage(header, sidebar, body)

# Server ----
server <- function(input, output) {
  
  x <- rnorm(10, 0, 2) %>% as.integer %>%  as.list
  
  # the df to be displayed as a DT::datatable. 
  setup_df <- create_sample_df(x)
  
  ex_df <- eventReactive(input$ex_df_cell_edit, {
    # on startup
    if (is.null(input$ex_df_cell_edit)) {
      setup_df
      
      # for edits
    } else {
      
      
      info = input$ex_df_cell_edit
      str(info)
      i = info$row
      j = info$col
      v = info$value
      
      # update budgets, which in turn is used to generate data during create_sample_df()
      x[[i]] <<- as.numeric(v)
      
      create_sample_df(x)
    }
  },
  ignoreNULL = FALSE)
  
  output$ex_df <- render_dt(data_in = ex_df,
                            rownames = FALSE,
                            list(target = 'cell', 
                                 disable = list(columns = c(1))))
  
}

shinyApp(ui, server)