How to use Shiny inputs to filter a Datatable that has been edited?

Question

I'm stumped on a three part process:

1. I'm trying to filter what is displayed to a dataTable via Shiny inputs (in the real app there would be dozens of these).
2. Then, I'd like to edit cell values in the DT.
3. Finally, I'd like to be able to change the filters and keep the edited cell values.

The example app below does 1 and 2, but not 3. After I make an edit AND click the only_johns checkbox, the dataTable displays the original data.

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
              downloadButton("downloadResults","Download Results"),
              checkboxInput("only_johns", "only_johns")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = 'admin', class = 'active', 
      fluidRow(
        box(
          dataTableOutput('userTable'), width = 6
        )
      )
    )
  )
)


ui <- dashboardPage(title = 'admin function test', header, sidebar, body)

server <- function(input, output, session){
  
  #1
  start.df <- reactiveValues(data=NA)
  start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
                    id = 1:60, stringsAsFactors = FALSE)
  

  #2  temp display filters df
  display.df <- reactiveValues(data=start.df)
  observe({
    
    temp <- isolate(start.df$data)
    if (input$only_johns) {
      
    display.df$data <- temp[temp$userName == "John",]
    } else {
      display.df$data <- temp
    }
  })
  
# Display editable datatable
  output$userTable <- renderDataTable({
    req(display.df$data)
    DT::datatable(isolate(display.df$data),
                  editable = TRUE,
                  rownames = FALSE)
  })
  
  ###Tracking Changes###

  proxy = dataTableProxy('userTable')
  observe({
    DT::replaceData(proxy, display.df$data, rownames = FALSE, resetPaging = FALSE)
  })
  
  observeEvent(input$userTable_cell_edit, {
    display.df$data <<- editData(display.df$data, input$userTable_cell_edit, rownames = FALSE)
  })
  
  
  output$downloadResults <- downloadHandler(
    filename = function(){paste("userTest.csv", sep = "")},
    content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
  )
  
}

shinyApp(ui = ui, server = server)

Answer 1

So far you only update the diplay.df$data, but you need to update the original start.df$data. I've included this in my solution, to find the correct row irrespective of the current filtering, I've introduced the column row_id that is hidden in the DT. Also, I've simplified your code a bit.

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
    downloadButton("downloadResults","Download Results"),
    checkboxInput("only_johns", "only_johns")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = 'admin', class = 'active', 
      fluidRow(
        box(
          dataTableOutput('userTable'), width = 6
        )
      )
    )
  )
)


ui <- dashboardPage(title = 'admin function test', header, sidebar, body)

server <- function(input, output, session){
  
  #1
  start.df <- reactiveValues(data=NA)
  start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
                              id = 1:60,
                              row_id = 1:60,
                              stringsAsFactors = FALSE)
  
  
  #2  temp display filters df
  display.df <- reactiveValues(data=start.df)
  observeEvent(input$only_johns, {
    
    temp <- isolate(start.df$data)
    if (input$only_johns) {
      
      display.df$data <- temp[temp$userName == "John",]
    } else {
      display.df$data <- temp
    }
  })
  
  # Display editable datatable
  output$userTable <- renderDataTable({
    req(display.df$data)
    DT::datatable(isolate(display.df$data),
                  editable = TRUE,
                  rownames = FALSE,
                  options = list(
                    columnDefs = list(
                      list(
                        visible = FALSE,
                        targets = 2
                      )
                    )
                  ))
  })
  
  ###Tracking Changes###
  
  proxy = dataTableProxy('userTable')

  observeEvent(input$userTable_cell_edit, {
    
    display.df$data <- editData(display.df$data, input$userTable_cell_edit, rownames = FALSE)
    DT::replaceData(proxy, display.df$data, rownames = FALSE, resetPaging = FALSE)
    
    # update the data in the original df
    # get the correct row_id
    curr_row_id <- display.df$data[input$userTable_cell_edit[["row"]], "row_id", drop = TRUE]
    # get the correct column position
    column_pos <- input$userTable_cell_edit[["col"]] + 1 # DT starts indexing at 0
    # update the data
    temp <- start.df$data
    temp[temp$row_id == curr_row_id, column_pos] <- input$userTable_cell_edit[["value"]]
    start.df$data <- temp
  })
  
  
  output$downloadResults <- downloadHandler(
    filename = function(){paste("userTest.csv", sep = "")},
    content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
  )
  
}

shinyApp(ui, server)

Edit

Here is a version where the page gets not reset. The problem was that with the edited data, display.df$data was changed, which triggered the rerendering of output$userTable and this resetted the page. To circumvent this, I've added another reactive value that contains the edited data and don't change display.df anymore, it is only changed by changing the input filtering.

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
    downloadButton("downloadResults","Download Results"),
    checkboxInput("only_johns", "only_johns")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = 'admin', class = 'active', 
      fluidRow(
        box(
          dataTableOutput('userTable'), width = 6
        )
      )
    )
  )
)


ui <- dashboardPage(title = 'admin function test', header, sidebar, body)

server <- function(input, output, session){
  
  #1
  start.df <- reactiveValues(data=NA)
  start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
                              id = 1:60,
                              row_id = 1:60,
                              stringsAsFactors = FALSE)
  
  
  #2  temp display filters df
  display.df <- reactiveValues(data=isolate(start.df))
  edit.df <- reactiveValues(data = isolate(start.df))
  observeEvent(input$only_johns, {
    
    temp <- isolate(start.df$data)
    if (input$only_johns) {
      
      display.df$data <- temp[temp$userName == "John",]
      edit.df$data <- temp[temp$userName == "John",]
    } else {
      display.df$data <- temp
      edit.df$data <- temp
    }
  })
  
  # Display editable datatable
  output$userTable <- renderDataTable({
    req(display.df$data)
    DT::datatable(display.df$data,
                  editable = TRUE,
                  rownames = FALSE,
                  options = list(
                    columnDefs = list(
                      list(
                        visible = FALSE,
                        targets = 2
                      )
                    )
                  ))
  })
  
  ###Tracking Changes###
  
  proxy = dataTableProxy('userTable')

  observeEvent(input$userTable_cell_edit, {
    
    edit.df$data <- editData(edit.df$data, input$userTable_cell_edit, rownames = FALSE)
    DT::replaceData(proxy, edit.df$data, rownames = FALSE, resetPaging = FALSE)
    
    # update the data in the original df
    # get the correct row_id
    curr_row_id <- edit.df$data[input$userTable_cell_edit[["row"]], "row_id", drop = TRUE]
    # get the correct column position
    column_pos <- input$userTable_cell_edit[["col"]] + 1 # DT starts indexing at 0
    # update the data
    temp <- start.df$data
    temp[temp$row_id == curr_row_id, column_pos] <- input$userTable_cell_edit[["value"]]
    start.df$data <- temp
  })
  
  
  output$downloadResults <- downloadHandler(
    filename = function(){paste("userTest.csv", sep = "")},
    content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
  )
  
}

shinyApp(ui, server)