R- Shiny- DT: editting both Parent- child tables and updating each other

Viewed 658

I have a data table with data like these: On a given DAY, multiple shops (SHOP) are visited and the number of products with high (RED_VAL), moderate (YELLOW_val) and low (GREEN_VAL) prices is recorded. Then the total no. of products per shop is calculated in col. TOT. I want to display the data like this: enter image description here

Thus, sort them in two tables, with the first showing the days and the shops, and the second one all the other data. The second one should be edittable (allowing row modification and additions/ deletions). The first table should then be notified of any changes (ie in the SHOP col). Also, the TOT col. should be automatically updated, following any changes in the (*_VAL) columns.

My code looks like this so far:

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) 

Many thanks for your time!!!

3 Answers

Preamble

It all boils down to the question of how to use an editable table and to keep the data in the client and the server in sync.

You used DTedit a library which I am not aware of and never used, so I show you a DT only solution. Looking at the docs of DTedit I also think that the way how you tried to implement it (in particular mixing it w/ ordinary DT) is not how it meant to be used, but it is rather a replacement possibility for DT)

Code

Here we go (explanation below):

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)

Explanation

  1. I created a reactive value act_data which originally holds the original data, amended by a row id. The row id will be later used to identify rows properly. It is a reactive value, b/c we want the details table to react on changes of this.
  2. The summary/details tables are rendered once via render (note the isolate on act_data()/get_current_slice()). This is done, b/c we want the changes to be triggered only in the edit part (otherwise we would lose the selected rows info). We also hide the rowid coumn b/c we need it only internally.
  3. We define proxy objects. These are used to update the tables on the client side.
  4. We define an observer, which triggers when we edit a cell. First it finds the id of the changed record then changes the value on the server in act_data. Eventually, we have to update the tables (which we deliberately isolated from changes in the data) via replaceData. The last part is simply done, such that we can keep the selected rows. If we would take a dependence on the raw data itself, the table would always be rendered afresh and the selection goes away.
  5. To get updated totals, we simply update the colum in get_current_slice

Caveats / ToDoS

The presented solution does not allow for adding/deleting entire rows out of the box. This can be added via actionButtons which implement the logic for adding / removing.

DTedit may ship with these possibilities as well, but as said I never used this library. Furthermore, as stated I think that DTedit is meant a lieu of a DT object and not as a complement.

I decided that it makes sense only to change the shops and the values but not the day/total column.

Here is an example using dtedit. This solution does allow adding and deleting rows to a particular 'day'. The default restricts the available 'shop' to the shops that already exist in the dataframe, through a 'pickdown' list. It is possible to define the shop options.

The code is very heavily based on thothal's answer, and I wouldn't have been able to do it without thothals's example!

I have only tested on my own heavily modified version of dtedit, but it may work with the original version.

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)

Thanks a million to both @thothal & @David Fong for their substantiated inputs!

Just in case anyone else is interested, I have come up with a solution (based on the above) that allows ALSO to update the details table, given changes in the summary table (additions/ modifications in SHOPS).

My knowledge on shiny is very primitive, so probably this is not the ideal solution (anyway, it works for me... as they say).

It should be noted that this works with David Fong's DTedit version.

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