How to excract data from edited datatable in shiny - r

Question

I want to creat an shiny app where users have to edit datatable.
There is the code contains reproductible exemple:
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 user clic on refresh button. Dtdust.csv (here simulated) is read , then it merged with boe.csv (simulated too) an filter to get only rows without resulta for voile and depot col.
And display this merged filtred ino 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 exemple to do it with classic dataframe but it not work with reactive one.
I’m beeginner so if you can comment a lot your answers i can learn how to and not just ctrl+c ctrl+v your code :)
Thanks

Answer 1

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)

Answer 2

Hi thanks for your solution #YBS.
I finaly find a solution by myself half an hour after asking here... (i previously turning arround hours and hours).
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
})
Have a good day