How to automate datatableProxy and table cells editing to a list of dataframes within Rshiny?

Viewed 66

In this reproducible example the user can edit the values of each tables before saving them into a csv file.

library(shiny)
library(DT)
library(data.table)

### A. Creating dummies dataframes

dummy_df1 = iris[45:55,]
dummy_df1$soil_type = c("A", "A", "C", "A", "D", "B", "A", "C", "D", "B")

dummy_df2 = iris[1:5,]

dummy_df3 = iris[1:3,2:5]

tables_list = list(dummy_df1, dummy_df2, dummy_df3)

pimped_tables =list()

### B. Pimping dataframes

for (i in 1:length(tables_list)) {

  #1. transposing table
  pimped_tables[[i]] <- data.table::transpose(tables_list[[i]])
  
  #2. colnames and rownames formatting
  rownames(pimped_tables[[i]]) <- colnames(tables_list[[i]])
  
  colnames(pimped_tables[[i]]) <- unlist(pimped_tables[[i]][row.names(pimped_tables[[i]])=='Species',])
  pimped_tables[[i]]<- pimped_tables[[i]][!row.names(pimped_tables[[i]])=='Species',]
}

### C. UI 

ui = fluidPage(fluidRow(
  column(width = 1),
  column(width =10,
         DT::dataTableOutput("df1"),
         actionButton("saveBtn1","save changes"),fluidRow(br()),
         DT::dataTableOutput("df2"),
         actionButton("saveBtn2","save changes"),fluidRow(br()),
         DT::dataTableOutput("df3"),
         actionButton("saveBtn3","save changes")),
  column(width=1)))

#D. Server part

server = function(input, output, session){
  
  
  x = reactiveValues(df = NULL)
  
  observe({
    df <- pimped_tables[[1]]
    x$df <- df
  })
  
  output$df1 = DT::renderDataTable({
    datatable(
      caption = HTML('<h3 style="color:#4dab44"><b> Dummy df1 </h3'),
      x$df, 
      rownames = TRUE,
      options = list(
        scrollX = TRUE,
        columnDefs = list(list(className = 'dt-center', targets = "_all")),
        selection = 'none'),
      selection=list(mode="single", target="cell"),
      editable = list(target = 'cell', disable = list(columns = 0)))
  })
  
  proxy_df1 = dataTableProxy('df1')
  
  observeEvent(input$df1_cell_edit,{
    
    info = input$df1_cell_edit
    str(info)
    i = info$row
    j = info$col 
    v = info$value
    
    x$df[i, j] <- isolate(DT::coerceValue(v, x$df[i, j]))
  })
  
  observeEvent(input$saveBtn1,{
    df1_initial_format = data.table::transpose(x$df)
    colnames(df1_initial_format) = rownames(x$df)
    
    df1_initial_format$Species = colnames(x$df)
    print(df1_initial_format)
    
    write.csv(df1_initial_format, "dummy_df1.csv")
  })
  
  
  x2 = reactiveValues(df = NULL)
  
  observe({
    df <- pimped_tables[[2]]
    x2$df <- df
  })
  
  output$df2 = DT::renderDataTable({
    datatable(
      caption = HTML('<h3 style="color:#4dab44"><b> Dummy df2 </h3'),
      x2$df, 
      rownames = TRUE,
      options = list(
        scrollX = TRUE,
        columnDefs = list(list(className = 'dt-center', targets = "_all")),
        selection = 'none'),
      selection=list(mode="single", target="cell"),
      editable = list(target = 'cell', disable = list(columns = 0)))
  })
  
  proxy_df2 = dataTableProxy('df2')
  
  observeEvent(input$df2_cell_edit,{
    
    info = input$df2_cell_edit
    str(info)
    i = info$row
    j = info$col 
    v = info$value
    
    x2$df[i, j] <- isolate(DT::coerceValue(v, x2$df[i, j]))
  })
  
  observeEvent(input$saveBtn2,{
    df2_initial_format = data.table::transpose(x2$df)
    colnames(df2_initial_format) = rownames(x2$df)
    
    df2_initial_format$Species = colnames(x2$df)
    print(df2_initial_format)
    
    write.csv(df2_initial_format, "dummy_df2.csv")
  }) 
  
  x3 = reactiveValues(df = NULL)
  
  observe({
    df <- pimped_tables[[3]]
    x3$df <- df
  })
  
  output$df3 = DT::renderDataTable({
    datatable(
      caption = HTML('<h3 style="color:#4dab44"><b> Dummy df3 </h3'),
      x3$df, 
      rownames = TRUE,
      options = list(
        scrollX = TRUE,
        columnDefs = list(list(className = 'dt-center', targets = "_all")),
        selection = 'none'),
      selection=list(mode="single", target="cell"),
      editable = list(target = 'cell', disable = list(columns = 0)))
  })
  
  proxy_df3 = dataTableProxy('df3')
  
  observeEvent(input$df3_cell_edit,{
    
    info = input$df3_cell_edit
    str(info)
    i = info$row
    j = info$col 
    v = info$value
    
    x3$df[i, j] <- isolate(DT::coerceValue(v, x3$df[i, j]))
  })
  
  observeEvent(input$saveBtn3,{
    df3_initial_format = data.table::transpose(x3$df)
    colnames(df3_initial_format) = rownames(x3$df)
    
    df3_initial_format$Species = colnames(x3$df)
    print(df3_initial_format)
    
    write.csv(df3_initial_format, "dummy_df3.csv")
  })
  
}

shinyApp(ui=ui, server=server)

Since I would like to reproduce this behaviour for 37 tables in my actual ShinyApp I was wondering if there was a way to not create a new dataTableProxy and a new observeEvent based on the table_cell_edit for every table ? Is it possible to apply a function to my list of dataframes that would do the same job ?

1 Answers

You could use Shiny modules:

  1. Create a module UI to display one table : tableUI
  2. Create a module Server to hande actions on this table : tableServer
  3. In the application Server :
    • Generate the application UI with renderUI calling tableUI in a loop for each table
    • Call tableServer in a loop for each table
library(shiny)
library(DT)
library(data.table)


### A. Creating dummies dataframes

dummy_df1 = iris[45:55,]
dummy_df1$soil_type = c("A", "A", "C", "A", "D", "B", "A", "C", "D", "B","B")

dummy_df2 = iris[1:5,]

dummy_df3 = iris[1:3,2:5]

tables_list = list(dummy_df1, dummy_df2, dummy_df3)

pimped_tables =list()


### B. Pimping dataframes

for (i in 1:length(tables_list)) {
  
  #1. transposing table
  pimped_tables[[i]] <- data.table::transpose(tables_list[[i]])
  
  #2. colnames and rownames formatting
  rownames(pimped_tables[[i]]) <- colnames(tables_list[[i]])
  
  colnames(pimped_tables[[i]]) <- unlist(pimped_tables[[i]][row.names(pimped_tables[[i]])=='Species',])
  pimped_tables[[i]]<- pimped_tables[[i]][!row.names(pimped_tables[[i]])=='Species',]
}


### C. module UI

tableUI <- function(id) {
  ns <- NS(id)
  tagList(
    DT::dataTableOutput(ns('table')),
    actionButton(ns("saveBtn"),"save changes"),
    fluidRow(br())
  )
}


### D. App UI 

ui = fluidPage(fluidRow(
  column(width = 1),
  column(width =10,
  uiOutput("tables"),  
  column(width=1))))


### E. module Server

tableServer <- function(id,data) {
  moduleServer(
    id,
    function(input, output, session) {
  x = reactiveValues(df = data)
      
  output$table = DT::renderDataTable({
    datatable(
      caption = HTML(paste0('<h3 style="color:#4dab44"><b> Dummy ',id,' </h3')),
      x$df, 
      rownames = TRUE,
      options = list(
        scrollX = TRUE,
        columnDefs = list(list(className = 'dt-center', targets = "_all")),
        selection = 'none'),
      selection=list(mode="single", target="cell"),
      editable = list(target = 'cell', disable = list(columns = 0)))
  })
  
  proxy_table = dataTableProxy('table')
  
  observeEvent(input$table_cell_edit,{
    
    info = input$table_cell_edit
    str(info)
    i = info$row
    j = info$col 
    v = info$value
    
    x$df[i, j] <- isolate(DT::coerceValue(v, x$df[i, j]))
  })
  
  observeEvent(input$saveBtn,{
    df_initial_format = data.table::transpose(x$df)
    colnames(df_initial_format) = rownames(x$df)
    
    df_initial_format$Species = colnames(x$df)
    print(df_initial_format)
    
    write.csv(df_initial_format, paste0("dummy_",id,".csv"))
  })
    }) 

}


### F. App Server

server = function(input, output, session){
  
  output$tables <- renderUI({
    lapply(1:length(pimped_tables),function(i) tagList(tableUI(paste0("df",i)),fluidRow(br())))
  })
  
  for (i in 1:length(pimped_tables)) { tableServer(id=paste0("df",i),data=pimped_tables[[i]])}


}

shinyApp(ui=ui, server=server)


enter image description here

Related