时间戳

首页 > 解决方案 > R- Shiny- DT：编辑两个父子表并相互更新

r - R- Shiny- DT：编辑两个父子表并相互更新

问题描述

我有一个包含如下数据的数据表：在给定的一天，访问了多家商店 (SHOP)，并记录了价格高 (RED_VAL)、中等 (YELLOW_val) 和低 (GREEN_VAL) 价格的产品数量。然后总号。每家商店的产品数量以 col 计算。托特。我想显示这样的数据： 在此处输入图像描述

因此，将它们排序在两个表中，第一个显示日期和商店，第二个显示所有其他数据。第二个应该是可编辑的（允许行修改和添加/删除）。然后应该将任何更改通知第一个表（即在 SHOP col 中）。此外，TOT 上校。应在 (*_VAL) 列中发生任何更改后自动更新。

到目前为止，我的代码如下所示：

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


df <-   data.frame(
DAY = c("day1", "day1", "day1", "day4", "day4","day6", "day6", "day8", "day8", "day8"), 
SHOP = c("shop1", "shop2","shop3", "shop1", "shop2", "shop6", 
"shop7", "shop8", "shop9","shop10"), 
TOT = c(16, 19, 22, 25, 28, 31, 34, 37, 40, 43), 
GREEN_VAL = c(3,4, 5, 6, 7, 8, 9, 10, 11, 12), 
YELLOW_VAL = c(5, 6, 7, 8, 9,10, 11, 12, 13, 14), 
RED_VAL = c(8, 9, 10, 11, 12, 13, 14, 15,16, 17))

# create a summary table
summary_df = df %>%
  group_by(DAY) %>%
  summarize(SHOPS = paste(SHOP, collapse = ','))


ui <- fluidPage(DT::dataTableOutput("yy")
                , DT::dataTableOutput("kidd"))

server <- function(input, output) {
  # display the data that is available to be drilled down
  
  #parent
  sum1 <- dtedit(input,
                 output,
                 name = 'summary',
                 thedata = (summary_df))
  
  output$yy <-
    DT::renderDataTable(
      datatable(
        sum1$thedata,
        extensions = 'Buttons',
        filter = "top",
        selection = "single",
        editable = T,
        options = list(
          autoWidth = TRUE,
          dom = 'Blfrtip',
          buttons = c('colvis', 'copy', 'csv', 'excel', 'pdf', 'print')
        )
      )
    )
  
  
  
  # for selected row... get child
  observeEvent(input$yy_rows_selected, {
    selected_days <-
      summary_df[as.integer(input$yy_rows_selected), ]$DAY
    drilldata = df[df$DAY %in% selected_days, ]
    
    
    # display child
    
        kid <- dtedit(input,
                  output,
                  name = 'summary',
                  thedata = drilldata)
    
    
    output$kidd <-
      DT::renderDataTable(
        datatable(
          kid$thedata,
          extensions = 'Buttons',
          filter = "top",
          selection = "single",
          editable = T,
          options = list(
            autoWidth = TRUE,
            dom = 'Blfrtip',
            buttons = c('colvis', 'copy', 'csv', 'excel', 'pdf', 'print')
          )
        )
      )
    
    
    
  })
  
    
}

shinyApp(ui, server)

非常感谢您的时间！！！

标签： rshiny

解决方案

前言

这一切都归结为如何使用可编辑表并保持客户端和服务器中的数据同步的问题。

您使用 DTedit了一个我不知道且从未使用过的库，所以我向您展示了一个DT唯一的解决方案。查看文档DTedit我还认为您尝试实现它的方式（特别是与普通混合DT）不是它的使用方式，而是它的替代可能性DT）

代码

我们开始吧（下面的解释）：

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

orig_data <- data.frame(
   DAY        = c("day1", "day1", "day1", "day4", "day4","day6", "day6", 
                  "day8", "day8", "day8"), 
   SHOP       = c("shop1", "shop2","shop3", "shop1", "shop2", "shop6", 
                  "shop7", "shop8", "shop9","shop10"), 
   TOT        = c(16, 19, 22, 25, 28, 31, 34, 37, 40, 43), 
   GREEN_VAL  = c(3, 4, 5, 6, 7, 8, 9, 10, 11, 12), 
   YELLOW_VAL = c(5, 6, 7, 8, 9,10, 11, 12, 13, 14), 
   RED_VAL    = c(8, 9, 10, 11, 12, 13, 14, 15, 16, 17))


ui <- fluidPage(DTOutput("summary"), 
                DTOutput("details"))

get_summary <- function(in_data) {
   in_data %>%
      group_by(DAY) %>%
      summarize(SHOPS = paste(SHOP, collapse = ','))
}

server <- function(input, output, session) {
   act_data <- reactiveVal(rowid_to_column(orig_data))

   proxy_summary <- dataTableProxy("summary")
   proxy_details <- dataTableProxy("details")

   get_current_slice <- reactive({
      my_data <- req(act_data())
      my_data %>%
         filter(DAY == get_summary(my_data) %>%
                   slice(req(input$summary_rows_selected)) %>%
                   pull(DAY)) %>%
         mutate(TOT = GREEN_VAL + YELLOW_VAL + RED_VAL)
   })
   
   output$summary <- renderDT({
      datatable(
         get_summary(req(isolate(act_data()))), 
         extensions = "Buttons",
         rownames   = FALSE,
         filter     = "top",
         selection  = "single",
         editable   = FALSE,
         options    = list(
            autoWidth = TRUE,
            dom       = "Blfrtip",
            buttons   = c("colvis", "copy", "csv", "excel", "pdf", "print")
         )
      )
   })
   
   output$details <- renderDT({
      req(input$summary_rows_selected)
      datatable(
         req(isolate(get_current_slice())),
         extensions = "Buttons",
         rownames   = FALSE,
         filter     = "top",
         selection  = "single",
         editable   = list(target = "cell", disable = list(columns = c(0:1, 3))),
         options    = list(
            autoWidth  = TRUE,
            dom        = "Blfrtip",
            buttons    = c("colvis", "copy", "csv", "excel", "pdf", "print"),
            columnDefs = list(list(visible = FALSE, targets = 0))
            
         )
      )
   })   
   
   observeEvent(input$details_cell_edit, {
      data_slice <- req(get_current_slice())
      my_data <- req(act_data())
      edit_info <- req(input$details_cell_edit)
      i <- edit_info$row
      j <- edit_info$col + 1
      id <- data_slice[i, 1]
      my_data[my_data$rowid == id, j] <- coerceValue(edit_info$value, 
                                                     my_data[my_data$rowid == id, j])
      act_data(my_data)
      replaceData(proxy_summary, 
                  get_summary(act_data()), 
                  resetPaging = FALSE, 
                  rownames = FALSE,
                  clearSelection = FALSE)
      ## replace data to update TOT column if needed
      replaceData(proxy_details,
                  get_current_slice(), 
                  resetPaging = FALSE, 
                  rownames = FALSE,
                  clearSelection = FALSE)
   })
}

shinyApp(ui, server)

解释

  1. 我创建了一个反应值act_data，它最初保存原始数据，并由行 id 修改。行 ID 稍后将用于正确识别行。这是一个反应值，b/c 我们希望详细信息表对它的变化做出反应。
  2. 摘要/详细信息表通过（注意on ）呈现一次。这完成了，b/c 我们希望仅在编辑部分触发更改（否则我们将丢失选定的行信息）。我们还隐藏了我们仅在内部需要它的 coumn b/c。renderisolateact_data()/get_current_slice()rowid
  3. 我们定义代理对象。这些用于更新客户端的表。
  4. 我们定义了一个观察者，它在我们编辑一个单元格时触发。首先它找到已id更改记录的 ，然后在服务器上更改 中的值act_data。最终，我们必须通过replaceData. 最后一部分简单完成，这样我们就可以保留选定的行。如果我们依赖原始数据本身，表格将始终重新呈现，选择消失。
  5. 要获得更新的总数，我们只需更新列get_current_slice

警告/待办事项

提出的解决方案不允许添加/删除开箱即用的整行。这可以通过actionButtons实现添加/删除的逻辑来添加。

DTedit也可能附带这些可能性，但如前所述，我从未使用过这个库。此外，如前所述，我认为这DTedit意味着代替DT对象而不是作为补充。

我决定只更改商店和值而不是天/总计列是有意义的。

推荐阅读