如何编辑反应式数据表？

Question

因此，我目前正在开发一个闪亮的应用程序，其目标是显示一个按各种参数（如 ID 或年份）过滤的表格，其中包含

old value

和

new value

列（首先相同），其中

new value

列是可编辑的为了计算旧值和新值之间的差异（我们将其称为“主表”）。

此应用程序还需要显示所有旧值和所有新值之和之间的差异，以可视化所有更改如何影响全局分数（我们将其称为“聚合表”）。

我使用了 DT 包，它允许通过闪亮的数据表进行编辑，并设法使用非反应性数据表作为输入来让主表和聚合表工作。但是，当我尝试使用反应式参数来使用所需参数对其进行过滤时，它不起作用。我做了多次尝试，每次都进行了各种调整以使其工作，而我最接近我想要的就是拥有一个反应式主表和聚合表，它们会根据参数而变化，但是当我尝试编辑主表时表应用程序崩溃。

这是最新版本的代码：

###### Attempt at creating an editable reactive DataTable


### Import Libraries

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


### Quality of Life functions (can be ignored)

f0 <- label_number(accuracy = 1)
f2 <- label_number(accuracy = 0.01)

format_value <- function(f, value, symbol) {
  return(paste0(f(value), symbol))
}

as.percent <- function(x) {
  return(round(100 * x, 2))
}

js <- c(
  "table.on('key', function(e, datatable, key, cell, originalEvent){",
  "  var targetName = originalEvent.target.localName;",
  "  if(key == 13 && targetName == 'body'){",
  "    $(cell.node()).trigger('dblclick.dt');",
  "  }",
  "});",
  "table.on('keydown', function(e){",
  "  var keys = [9,13,37,38,39,40];",
  "  if(e.target.localName == 'input' && keys.indexOf(e.keyCode) > -1){",
  "    $(e.target).trigger('blur');",
  "  }",
  "});",
  "table.on('key-focus', function(e, datatable, cell, originalEvent){",
  "  var targetName = originalEvent.target.localName;",
  "  var type = originalEvent.type;",
  "  if(type == 'keydown' && targetName == 'input'){",
  "    if([9,37,38,39,40].indexOf(originalEvent.keyCode) > -1){",
  "      $(cell.node()).trigger('dblclick.dt');",
  "    }",
  "  }",
  "});"
)


### Data Creation
data_test <- tibble(id = rep(1:2, times = 6), annee = rep(2020:2021, each = 6), 
                    old_value = rep((10:21)*5), new_value = old_value, diff = new_value - old_value)


### Server Section

# Main DataTable function

mod_table_edit <- function(id, data_initialisation) {
  moduleServer(id, function(input, output, session) {
    # initialise the reactive data object for the table
    data <- reactive({data_initialisation()})
    
    # render the table
    output$table <- renderDT({
      datatable(data(),
                selection = 'none', editable = list(target = 'cell', disable = list(columns = c(1:3, 5))),
                callback = JS(js), extensions = "KeyTable", options = list(keys = TRUE)
      )})
    
    # update the underlying data
    observeEvent(input$table_cell_edit, {
      data() <- editData(data(), input$table_cell_edit) %>%  
        mutate(diff = new_value - old_value)
    })
    
    # return the data as a reactive
    return(reactive(data()))
  })
}

# Second DataTable function

mod_table_add <- function(id, data_aggreg) {
  moduleServer(id, function(input, output, session) {
    # do the calculations
    data_table <- reactive({data_aggreg() %>% 
        summarise(Tot_old_value = sum(old_value) %>% round(), Tot_new_value = sum(new_value) %>% round(),
                  Tot_diff = Tot_new_value-Tot_old_value %>% round(), Hausse_Tot = as.percent((Tot_new_value/Tot_old_value)-1)
        )
    })
    
    # render the table
    output$table <- renderDT({datatable(
      data_table() %>% mutate(Hausse_Tot = format_value(f2, Hausse_Tot, " %")),
      rownames = FALSE, editable = 'none')})
  })
}


server <- function(input, output, session) {
  
  data_filt_id <- reactive({data_test %>% filter(id == input$slct_id)})
  
  observeEvent(input$slct_id, {
    choices <- as.integer(unique(data_filt_id()$annee))
    
    # Can also set the label and select items
    freezeReactiveValue(input, "slct_annee")
    updateSelectInput(session,"slct_annee",
                      label = "Annee",
                      choices = choices,
                      selected = tail(choices, 1))
  })
  
  data_filt <- reactive({data_filt_id() %>% filter(annee == input$slct_annee)})
  
  # call the modules for the editable tables and store the results
  data_value <- mod_table_edit("value_table", data_initialisation = data_filt)
  
  # call the module for the table that takes inputs
  # the reactives musn't be evaluated
  mod_table_add("table_aggregats", data_aggreg = data_value)
}



### UI section

# UI module to display the tables
modFunctionUI <- function(id) {
  ns <- NS(id)
  DTOutput(ns("table"))
}

ui <- dashboardPage(
  dashboardHeader(title = "DummyApp"),
  dashboardSidebar(sidebarMenu(menuItem("Tables Calc", tabName = "T_Calc", icon = icon("dashboard")))
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "T_Calc",
        fluidRow(
          column(width = 3),
          column(width = 3,
                 selectInput(
                   "slct_id", "ID",
                   choices = unique(data_test$id),
                   selected = 1,
                   selectize = TRUE)),
          column(width = 3,
                 selectInput(
                   "slct_annee", "Annee",
                   choices = unique(data_test$annee),
                   selected = 2020)
          )),
        fluidRow(
          modFunctionUI("value_table"),
          modFunctionUI("table_aggregats")
        ))))
)


### Run Application
shinyApp(ui, server)

我很确定问题来自服务器部分，特别是主表函数的

# update underlying data

部分，但我无法理解如何使其按预期工作。 我也尝试使用

reactiValues()

代替

reactive()

，但也没有取得多大成功。

是否可以使用 R Shiny 同时拥有反应式 和 可编辑数据表？

Answer 1

您可以使用 make

data

a

reactiveVal

在

observeEvent

中更新它。要初始化

data

，我使用

observe

。另外，我在

req(data_aggreg())

内添加了

mod_table_add

，以防止表在

data

初始化之前“崩溃”：

# Main DataTable function
mod_table_edit <- function(id, data_initialisation) {
  moduleServer(id, function(input, output, session) {
    # initialise the reactive data object for the table
    data <- reactiveVal()
    
    observe(
      data(
        data_initialisation()
      )
    )

    output$table <- renderDT({
      datatable(data(),
        selection = "none",
        editable = list(target = "cell", disable = list(columns = c(1:3, 5))),
        callback = JS(js), extensions = "KeyTable", options = list(keys = TRUE)
      )
    })

    # update the underlying data
    observeEvent(input$table_cell_edit, {
      data(
        editData(data(), input$table_cell_edit) %>%
          mutate(diff = new_value - old_value)
      )
    })

    # return the data as a reactive
    return(data)
  })
}

mod_table_add <- function(id, data_aggreg) {
  moduleServer(id, function(input, output, session) {
    # do the calculations
    data_table <- reactive({
      req(data_aggreg())
      data_aggreg() %>%
        summarise(
          Tot_old_value = sum(old_value) %>% round(), Tot_new_value = sum(new_value) %>% round(),
          Tot_diff = Tot_new_value - Tot_old_value %>% round(), Hausse_Tot = as.percent((Tot_new_value / Tot_old_value) - 1)
        )
    })

    # render the table
    output$table <- renderDT({
      datatable(
        data_table() %>% mutate(Hausse_Tot = format_value(f2, Hausse_Tot, " %")),
        rownames = FALSE, editable = "none"
      )
    })
  })
}