在闪亮的应用程序中动态创建可编辑的 DT

Question

我想创建一个具有以下流程的应用程序：

用户选择一些数据组
这些组成为动态选项卡，每个选项卡都包含一个子集可编辑
```
DT
```
与相应的组
每个选项卡都包含一个额外的反应式
```
DT
```
，它对#2 中创建的可编辑数据表的更改做出反应（在下面的示例中，简单地将数字列乘以二）

这里是执行#1 和#2 的示例。但是，#3 不起作用，因为通常通过可编辑

DT

公开的信息没有出现在我的

input

中，这可能是由于某些范围界定或呈现问题的顺序。

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

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel = 
      sidebarPanel(
        selectInput("cars", "Pick a vehicle", rownames(mtcars), multiple = T),
        actionButton("add", "Create Tabs")
      ),
    mainPanel = 
      mainPanel(
        tabsetPanel(
          id = "panel"
        )
      )
  )
)

server <- function(input, output, session) {
  
  df <- tibble::rownames_to_column(mtcars, "car")
  data <- reactiveVal()
  observe({
    req(df, input$cars)
    # Step 1) split data by user input groups
    df |>
      filter(car %in% input$cars) |>
      split(~ car) |>
      data()
  })
  
  observeEvent(input$add, {
    req(input$cars, data())
    
    # Step 2) Editable DT with respective group
    # Creates output$<car name>
    lapply(input$cars, \(x) { output[[x]] <- renderDT(data()[[x]], 
                                                      rownames = F,
                                                      editable = "cell",
                                                      selection = "none")
    })
    
    # Step 3) Reactive DT that responds to user changes
    # Creates output$<car name>tbl
    lapply(input$cars, \(x) { output[[paste0(x, "tbl")]] <- renderDT({
      mutate(data()[[x]], across(where(is.numeric), ~ . * 2))
      })
    })
    
    # insert dynamic tabs with data
    lapply(input$cars, \(x) {
      insertTab("panel", tabPanel(x, 
                                  DTOutput(x), # access output$<car name>
                                  br(),
                                  DTOutput(paste0(x, "tbl")) # access output$<car name>
      )
      )
    })
    # input does not contain input$<vehicle selection>_cell_edit
    print(names(input)) # [1] "cars"  "add"   "panel"
  })
}

shinyApp(ui, server)

您可以在此示例中看到，将

mpg

更改为 10 后，第二个表不会反应性地显示 10*2 = 20。

通常，当您在服务器端创建一个

DT

时，例如

output$table <- renderDT(iris , editable = "cell")

，您可以访问存储在

input

对象中的信息（见 2.2 数据表信息）。其中之一是

input$table_cell_edit

（

input$table_

bc 作业是

output$table <-

），您可以使用它来创建反应事件。

由于我需要动态地执行此操作，因此我不能以这种方式对分配进行硬编码。

lapply

确实在我可以引用动态创建的项目的范围内工作（参见

DTOutput(...)

）。但是，您可以从

print

语句中看到，当通过

output

.

 完成

lapply

分配时，不会创建 DataTable 信息来捕获用户交互。

这个SO问题有类似的问题，但没有回应。与此 DT GitHub issue 相同，该问题也因无响应而关闭。

问题

所以，我的问题是如何在我的

DT

对象中动态创建可编辑的

output

，以便我可以访问有关编辑的

input

对象信息以创建反应链？

回答

在任何回复中，如果能看到完成上述 1-3 的代码会很棒，而且：

在用户编辑时调整第一个表下的数据
当用户编辑第一张表时调整第二张表下的数据
提供有关为什么我的代码不起作用的更多详细信息（我如何访问 DataTables
```
output$<car name>
```
和
```
output$<car name>tbl
```
，但没有
```
input
```
信息可访问？）

Answer 1

下面的代码应该可以实现你的目标。除了添加“# APPLY EDITS”部分外，我不需要做任何事情，看起来在打开选项卡时会创建必要的编辑输入。

我还在几个地方添加了

options = list(dom = "t")

以消除表格中的混乱（这消除了您最终应用程序可能不需要的“搜索”等功能，请参阅https://datatables.net/reference /option/dom 以获得更多详细信息），并为修改后的表设置

rownames = F

。请注意，如果没有行名，我们需要

+ 1

中的

input[[paste0(x, "_cell_edit")]][["col"]] + 1

才能获得 DT（版本 0.27）的正确列。

希望这有帮助！如果这个答案与通常的惯例不一致，我深表歉意，我是 Stack Overflow 的新手。

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

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel = 
      sidebarPanel(
        selectInput("cars", "Pick a vehicle", rownames(mtcars), multiple = T),
        actionButton("add", "Create Tabs"),
        actionButton("update", "Update")
      ),
    mainPanel = 
      mainPanel(
        tabsetPanel(
          id = "panel"
        )
      )
  )
)

server <- function(input, output, session) {
  
  df <- tibble::rownames_to_column(mtcars, "car")
  data <- reactiveVal()
  observe({
    req(df, input$cars)
    # Step 1) split data by user input groups
    df |>
      filter(car %in% input$cars) |>
      split(~ car) |>
      data()
  })
  
  observeEvent(input$add, {
    req(input$cars, data())
    
    # Step 2) Editable DT with respective group
    # Creates output$<car name>
    lapply(input$cars, \(x) { output[[x]] <- renderDT(data()[[x]], 
                                                      rownames = F,
                                                      editable = "cell",
                                                      selection = "none",
                                                      options = list(dom = "t"))
    })
    
    # Step 3) Reactive DT that responds to user changes
    # Creates output$<car name>tbl
    lapply(input$cars, \(x) { output[[paste0(x, "tbl")]] <- renderDT(rownames = F, options = list(dom = "t"), {
      mutate(data()[[x]], across(where(is.numeric), ~ . * 2))
    })
    })
    
    # insert dynamic tabs with data
    lapply(input$cars, \(x) {
      insertTab("panel", tabPanel(x, 
                                  DTOutput(x), # access output$<car name>
                                  br(),
                                  DTOutput(paste0(x, "tbl")) # access output$<car name>
      )
      )
    })
    # input does not contain input$<vehicle selection>_cell_edit
    print(names(input)) # [1] "cars"  "add"   "panel"
  })
  
  # APPLY EDITS
  observeEvent(input$update, {
    
    lapply(input$cars, \(x) {
      holder <- as.data.frame(data()[[x]])
      holder[input[[paste0(x, "_cell_edit")]][["row"]], input[[paste0(x, "_cell_edit")]][["col"]] + 1] <- input[[paste0(x, "_cell_edit")]][["value"]]
      df[which(df == holder[1, 1], arr.ind = T)[1], ] <- holder
      df <<- df
    })
    
    data(df |>
           filter(car %in% input$cars) |>
           split(~ car))
    
    print("edit saved")
  })
}

shinyApp(ui, server)

Answer 2

TL;DR：如果您简单地添加逻辑来处理编辑，您的代码就可以工作并且“不担心”。要理解为什么需要一些细节。

你正确地注意到，当你的观察者运行时，你创建的输入其中并没有立即反映在

input

对象中。中的值

input

在服务器代码中是只读的。它们由客户端发送每个反应周期开始时的 JavaScript。你打电话时

appendTab()

你基本上从服务器 R 进程发送一些 HTML 到客户端网络浏览器，并要求它包含在带有 JavaScript 的页面中。只有在下一个反应周期中，客户端代码才会有已执行并包含动态创建的

input

值。

然而，输入不存在并不意味着你不能使用它们。

input

对象毕竟本质上是一个花哨的列表，用于跟踪哪些键被要求。如果访问不存在的密钥，您只需与常规 R 列表一样获得

NULL

。重要的是，

input

对象仍然注册对键的反应依赖，所以当那个 key later on is assigned a value，它被请求的上下文失效，所有内容都会相应更新。

您提到能够“访问”创建的输出。但是，调用

DTOutput()

不访问

output

对象的任何数据。它只是创建一些 HTML 代码，客户端 JavaScript 可以将其解释为填充从 R 进程发送的结果；尝试执行

DT::DTOutput("foo")

在控制台中。当您分配

DT::renderDT()

结果到

output

对象，您创建结果供JS处理。

将各个部分放在一起，这是具有行为的应用程序的代码你在找：

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("cars", "Pick vehicles", rownames(mtcars), multiple = TRUE)
    ),
    mainPanel(tabsetPanel(id = "tabset"))
  )
)

server <- function(input, output, session) {
  # Keep track of user-edited data
  car_datasets <- reactiveValues()

  # Create tabs for selections as needed
  observeEvent(input$cars, {
    added_cars <- setdiff(input$cars, names(car_datasets))
    lapply(added_cars, function(car) {
      # Populate initial data
      car_datasets[[car]] <- mtcars[car, ]

      # Create UI panel
      appendTab("tabset", tabPanel(
        title = car,
        DT::DTOutput(NS(car)("original")),
        DT::DTOutput(NS(car)("transformed"))
      ), select = TRUE)

      # Create outputs
      output[[NS(car)("original")]] <- DT::renderDT({
        DT::datatable(car_datasets[[car]], editable = "cell", selection = "none")
      })
      output[[NS(car)("transformed")]] <- DT::renderDT({
        dplyr::mutate_if(car_datasets[[car]], is.numeric, \(x) x * 2)
      })

      # Create observer to handle edits
      edit_input_id <- paste0(NS(car)("original"), "_cell_edit")
      observeEvent(input[[edit_input_id]], {
        car_datasets[[car]] <- DT::editData(car_datasets[[car]], input[[edit_input_id]])
      })
    })
  })
}

shinyApp(ui, server)

在闪亮的应用程序中动态创建可编辑的 DT

问题描述投票：0回答：2

2个回答

最新问题

在闪亮的应用程序中动态创建可编辑的 DT

问题描述 投票：0回答：2

2个回答

最新问题

问题描述投票：0回答：2