CODEWITHSUNDEEP
rshinydt
Ludo Vic
Ludo Vic

Reputation: 17

How to extract data from an edited datatable in shiny?

I want to creat an shiny app where users have to edit datatable. There is the code contains reproducible example:


library(shiny)
library(dplyr)
library(DT)
 
 
line<-c(1,1,1,1,1)
op<-c(155,155,155,156,156)
batch<-c(1,2,3,1,2)
voile<-c(1,NA,NA,NA,NA)
depot<-c(2,NA,2,NA,NA)
 
boe<-data.frame(line,op,batch)
 
ui <- fluidPage(
   
    # Application title
    titlePanel("test dust"),
   
    actionButton("refresh", label = "refresh"),
   
    DT::dataTableOutput("mytable"),
   
    actionButton("save", label = "save"),
 
)
 
# Define server logic required to draw a histogram
server <- function(input, output) {
   
    DTdust<- eventReactive(input$refresh, {
        DTdust <-data.frame(line,op,batch,voile,depot)
    })
   
    merged<-reactive({
        merged<-merge(boe,DTdust(),all.x = TRUE)
        })
   
    mergedfiltred<-reactive({
        mergedfiltred<- filter(merged(),is.na(voile)|is.na(depot) )
    })
   
    output$mytable = DT::renderDataTable( mergedfiltred(),editable = list(target = 'cell',
    disable = list(columns = c(1:3))),selection = 'none'
    )                                                                          
}
 
# Run the application
shinyApp(ui = ui, server = server)

I wish this works like this:

When a user clicks on refresh button, Dtdust.csv (here simulated) is read, then it is merged with boe.csv (simulated too) and filtered to get only rows without results for the voile and depot col. And display this merged filtered result into an editable datatable.

This part works.

After I want to extract the data from edited datatable to make some processing on it (extract rows completed, rbind it on dtdust and save as dtdust.csv. But that’s ok I think.) I'm in trouble to extract edited datatable. I see some example to do it with classic dataframe but it does not work with a reactive one.

Upvotes: 0

Views: 1710

Answers (2)

Ludo Vic
Ludo Vic

Reputation: 17

I finally found a solution by myself. There is what I do:


    output$x2 = DT::renderDataTable({
        req(dat$x2)
        DT::datatable(dat$x2)
    })
    dat <- reactiveValues()
   
    # update edited data
    observeEvent(input$mytable_cell_edit, {
        data_table <- dat$x2
        data_table[input$mytable_cell_edit$row, input$mytable_cell_edit$col] <- as.numeric(input$mytable_cell_edit$value)
        dat$x2 <- data_table
    })

Upvotes: 1

YBS
YBS

Reputation: 21287

You need to define a reactiveValues data frame. Then you need to update it via observeEvent whenever any cell is modified via mytable_cell_edit. The updated dataframe is now available in the server side, and part of it is now printed in the second table. You can use DF1$data for further analysis or subsetting. Full updated code is below.

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

line<-c(1,1,1,1,1)
op<-c(155,155,155,156,156)
batch<-c(1,2,3,1,2)
voile<-c(1,NA,NA,NA,NA)
depot<-c(2,NA,2,NA,NA)

boe<-data.frame(line,op,batch)

ui <- fluidPage(
  
  # Application title
  titlePanel("test dust"),
  
  actionButton("refresh", label = "refresh"),
  
  DTOutput("mytable"), DTOutput("tb2"),
  
  actionButton("save", label = "save"),
  
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  DF1 <- reactiveValues(data=NULL)
  
  DTdust<- eventReactive(input$refresh, {
    req(input$refresh)
    DTdust <-data.frame(line,op,batch,voile,depot)
  })
  
  merged<-reactive({
    req(DTdust())
    merged<-merge(boe,DTdust(),all.x = TRUE)
  })
  
  mergedfiltred<-reactive({
    mergedfiltred <- filter(merged(),is.na(voile)|is.na(depot) )
    DF1$data <- mergedfiltred
    mergedfiltred
  })
  
  output$mytable = renderDT( 
    mergedfiltred(),
    editable = list(target = 'cell', disable = list(columns = c(1:3))), selection = 'none'
  )
  
  observeEvent(input$mytable_cell_edit, {
    info = input$mytable_cell_edit
    str(info)
    i = info$row
    j = info$col  
    v = info$value
    
    DF1$data[i, j] <<- DT::coerceValue(v, DF1$data[i, j])
  })
  
  output$tb2 <- renderDT({
    df2 <- DF1$data[,2:5]
    plen <- nrow(df2)
    datatable(df2, class = 'cell-border stripe',
              options = list(dom = 't', pageLength = plen, initComplete = JS(
                "function(settings, json) {",
                "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
                "}")))
    
  })
  
}

# Run the application
shinyApp(ui = ui, server = server)

output

Upvotes: 1

Related Questions