R- Shiny- DT：編輯兩個父子表並相互更新

Question

我有一個包含如下數據的數據表：在給定的一天，訪問了多家商店 (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) 

非常感謝您的時間！！！

Answer 1

前言

這一切都歸結為如何使用可編輯表並保持客戶端和服務器中的數據同步的問題。

您使用了DTedit一個我不知道且從未使用過的庫，所以我向您展示了一個僅DT的解決方案。 查看DTedit的文檔，我還認為您嘗試實現它的方式（特別是與普通DT混合）並不是它的用途，而是DT的替代可能性）

代碼

這里我們 go （解釋如下）：

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. 摘要/詳細信息表通過render渲染一次（注意act_data()/get_current_slice()上的isolate ）。 這完成了，b/c 我們希望僅在編輯部分觸發更改（否則我們將丟失選定的行信息）。 我們還隱藏了我們僅在內部需要它的rowid coumn b/c。
3. 我們定義代理對象。 這些用於更新客戶端的表。
4. 我們定義了一個觀察者，它在我們編輯一個單元格時觸發。 首先，它找到更改記錄的id ，然后更改服務器上act_data中的值。 最終，我們必須通過replaceData更新表（我們故意將其與數據的變化隔離開來）。 最后一部分簡單完成，這樣我們就可以保留選定的行。 如果我們依賴原始數據本身，表格將始終重新呈現，選擇消失。
5. 要獲得更新的總數，我們只需更新get_current_slice中的列

警告/待辦事項

提出的解決方案不允許添加/刪除開箱即用的整行。 這可以通過實現添加/刪除邏輯的actionButtons添加。

DTedit也可能附帶這些可能性，但正如我所說的，我從未使用過這個庫。 此外，如上所述，我認為DTedit是DT object 的替代，而不是作為補充。

我決定只更改商店和值而不是天/總計列是有意義的。

Answer 2

這是使用dtedit的示例。 該解決方案確實允許在特定的“日”中添加和刪除行。 默認通過“選擇”列表將可用的“商店”限制為 dataframe 中已經存在的商店。 可以定義商店選項。

該代碼非常基於thothals的答案，如果沒有thothal的示例，我將無法做到！

我只測試了我自己經過大量修改的dtedit版本，但它可能適用於原始版本。

library(shiny)
library(DT)
library(DTedit)
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"),
                uiOutput("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")

  get_current_slice <- reactiveVal(
    data.frame(
      rowid = numeric(),
      DAY = character(), SHOP = character(),
      TOT = numeric(),
      GREEN_VAL = numeric(), YELLOW_VAL = numeric(), RED_VAL = numeric()
    )
  )
  shiny::observeEvent(
    c(act_data(), input$summary_rows_selected),
    ignoreInit = TRUE, ignoreNULL = TRUE, {
      my_data <- req(act_data())
      my_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)
      get_current_slice(my_data)
    })

  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")
      )
    )
  })

  details_results <- DTedit::dtedit(
    input, output,
    name = "details",
    thedata = get_current_slice,
    view.cols = c("DAY", "SHOP", "TOT", "GREEN_VAL", "YELLOW_VAL", "RED_VAL"),
    edit.cols = c("SHOP", "GREEN_VAL", "YELLOW_VAL", "RED_VAL")
  )

  shiny::observeEvent(details_results$thedata, {
    y <- shiny::req(act_data())
    y <- y %>%
      filter(DAY != get_summary(y) %>%
               slice(shiny::req(input$summary_rows_selected)) %>%
               pull(DAY))
    x <- details_results$thedata %>%
      mutate(TOT = GREEN_VAL + YELLOW_VAL + RED_VAL,
             rowid = dplyr::if_else(
               is.na(rowid), # if a new row
               as.integer(max(act_data()$rowid, na.rm = TRUE) + 1), # new rowid,
               rowid # otherwise just keep the 'old' rowid
             ),
             DAY = dplyr::if_else(
               is.na(DAY), # a new row
               get_summary(act_data()) %>%
                 slice(input$summary_rows_selected) %>%
                 pull(DAY), # copy the 'other' days in the slice
               DAY # otherwise just keep the 'old' DAY
             )
      )
    act_data(rbind(x,y))

    # update the summary table
    replaceData(proxy_summary,
                get_summary(act_data()),
                resetPaging = FALSE,
                rownames = FALSE,
                clearSelection = FALSE)
  })
}

shinyApp(ui, server)

Answer 3

感謝@thothal 和@David Fong 提供的經過證實的投入！

以防萬一其他人感興趣，我提出了一個解決方案（基於上述），允許 ALSO 更新詳細信息表，給定匯總表中的更改（商店中的添加/修改）。

我對 shiny 的了解非常原始，所以這可能不是理想的解決方案（無論如何，它對我有用......正如他們所說）。

需要注意的是，這適用於 David Fong 的 DTedit版本。

library(shiny)
library(DT)
library(dplyr)
library(tibble)
library(tidyr)
library(DTedit)
library(rlang)

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"), 
                uiOutput("kid"))

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")

  
  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 = list(mode = 'single', selected = 1),
      editable   = TRUE,
      options    = list(
        autoWidth = TRUE,
        dom       = "Blfrtip",
        buttons   = c("colvis", "copy", "csv", "excel", "pdf", "print")
      )
    )
  })
  
  data = reactiveVal({})
  
  
  data(rowid_to_column(orig_data))
  

  
  details <- dtedit(input,
                output,
                name = 'kid',
                edit.cols=c("YELLOW_VAL","RED_VAL"),
                thedata = data)
  
  # 
  
  observeEvent(input$summary_rows_selected, {
    data(isolate(get_current_slice()))
  })
  
  
  observeEvent(details$thedata, {

    if ( (details$edit.count)>0){

      data_slice <- req(get_current_slice())
      
       
      selected_days <-unique(data_slice$DAY)
       
            temp=isolate(act_data())%>%data.frame()%>%filter(DAY!=selected_days)
           
      if (!is_empty(selected_days)){
        temp1=bind_rows( details$thedata,temp)%>%unique()
        act_data(temp1)
      }
      
   
   

    ## replace data to update TOT column if needed
    data(isolate(get_current_slice()))


    details$edit.count<-0
    }
  })
  
  observeEvent(input$summary_cell_edit, {
    
    d1<-get_summary(req(isolate(act_data())))
    
    
    d1[input$summary_cell_edit$row,input$summary_cell_edit$col+1] <- input$summary_cell_edit$value
    
    # 
    zz=d1
    zz1=zz%>%group_by(DAY)%>%mutate(   SHOPS = strsplit(as.character(SHOPS), ",")) %>%
      unnest(SHOPS)%>%rename(SHOP=SHOPS)
    
    
    act_data2=left_join(zz1,act_data())
    act_data(act_data2)
    
  })
}

shinyApp(ui, server)