How to add persistent global filter on edited data table within the Module?

Hello,

Can anyone help me on this issue? I've been pulling hair for two days... Any suggestion and help would be much appreciated!!!

I'm working on adding global filter on edited data table within the Module. Currently, I'm able to use the control panel to filer the data table, but when I edit the cell, the edited cells can't be restored if I filter on different category or unfilter the table.

I got some idea from this post: Editing a reactive DT table that remembers the filtering context without page flickering - #2 by konradino , but it didn't work out in my case...

My ultimate goal is to edit the table on globally filtered data, and the filter should be persistent after the table is refreshed (edited).
...

# Libraries
library(shiny)
#> Warning: package 'shiny' was built under R version 4.0.5
library(data.table)
#> Warning: package 'data.table' was built under R version 4.0.5
library(dplyr, warn.conflicts = FALSE)
#> Warning: package 'dplyr' was built under R version 4.0.5
library(DT)
#> Warning: package 'DT' was built under R version 4.0.5
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable
library(tidyr)
#> Warning: package 'tidyr' was built under R version 4.0.5
library(lubridate, warn.conflicts = FALSE)
#> Warning: package 'lubridate' was built under R version 4.0.5

# Shiny options
options(shiny.maxRequestSize=Inf)
options(shiny.minified = TRUE)

#dataframe
raw1<-data.frame("Network"= c("50K","50K","50K","50K", "45K","45K","45K","45K", "40K","40K","40K","40K","30K","30K","30K","30K"), 
                 "BG_FLG"= c("B","B", "G","G","B","B", "G","G","B","B", "G","G","B","B", "G","G"), 
                 "SvcType"= c("R","D","R","D","R","D","R","D","R","D","R","D","R","D","R","D"))

raw2<- data.frame("Year"=c(2021,2022,2023,2024),
                  "Rate"=c(0.1,0.2,0.3,0.4))

raw<-merge(raw1,raw2) %>% spread(key=Year, value=Rate, fill = FALSE)


# Module for Rate ---------------------------------------------------------

#Module UI
RateUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns("Rate"))
}

#Module Server
RateServer <- function(id, data, networks, BG, DaysSupply){
  moduleServer(id, function(input, output,session){
   
     # multiple input variable in eventReactive
    mydata <- eventReactive({
      networks()
      BG()
      DaysSupply()
    },{
      # data must be assigned in this format: data <- data, otherwise filter will be invalid
      if (!('Select All' %in% networks()) & !is.null(networks())){
        data <- data %>%  filter(Network %in% networks())
      }
      if (!('Select All' %in% BG()) & !is.null(BG())) {
        data <- data %>% filter(BG_FLG %in% BG())
      }
      if (!('Select All' %in% DaysSupply()) & !is.null(DaysSupply())) {
        data <- data %>%  filter(SvcType %in% DaysSupply())
      } else{
        data <- data
      }
      return(data)
    })
    
    v = reactiveValues(df = NULL)
    
    observe({
      v$df <- mydata()
    })
    
    ### Edit Table
    proxy = dataTableProxy("Rate")
    
    observeEvent(input$Rate_cell_edit, {
      info = input$Rate_cell_edit
      str(info)
      i = info$row
      j = info$col
      k = info$value
      str(info)
      
      v$df[i, j] <<- DT::coerceValue(k, v$df[i, j])
     
      replaceData(proxy, v$df, resetPaging = FALSE)  # replaces data displayed by the updated table
    })
    
    
    # Table Output
    output$Rate <- DT::renderDataTable({
      DT::datatable(mydata(), editable = TRUE) %>%
        formatPercentage(c(4:ncol(mydata())), 0)
    })
    
    
    
  })
}

ui <- fluidPage(
  
  # Application title
  titlePanel("One-Filter Control"),
  tags$hr(),
  sidebarLayout(
    
    # Sidebar with a slider input
    sidebarPanel(
      selectInput("networks","Choose a network:",
                  choices = c("Select All",unique(toupper(raw$Network))),
                  selected = 'Select All',
                  multiple = FALSE),
      selectInput("BG","Choose B or G:",
                  choices = c("Select All", unique(raw$BG_FLG)),
                  selected = 'Select All',
                  multiple = FALSE),
      selectInput("DaysSupply","Choose R or D:",
                  choices = c("Select All", unique(raw$SvcType)),
                  selected = 'Select All',
                  multiple = FALSE),
      width = 2),
    
    # Show a plot of the generated distribution
    mainPanel(
      # DT::dataTableOutput("plan")
      tabsetPanel(
        tabPanel(
          "A",
          br(),
          RateUI("a")),
        tabPanel(
          "B",
          br(),
          RateUI("b")),
        tabPanel(
          "C",
          br(),
          RateUI("c"))
      )
    )
  )
)


server<-function(input, output, session){
  
  df1 <- RateServer("a", raw, networks = reactive(input$networks), BG = reactive(input$BG), 
                            DaysSupply= reactive(input$DaysSupply))
  
  df2 <- RateServer("b", raw, networks = reactive(input$networks), BG = reactive(input$BG), 
                              DaysSupply= reactive(input$DaysSupply))
  
  df3 <- RateServer("c", raw, networks = reactive(input$networks), BG = reactive(input$BG), 
                              DaysSupply= reactive(input$DaysSupply))
}

shinyApp(ui, server)
Shiny applications not supported in static R Markdown documents

Created on 2021-04-30 by the reprex package (v2.0.0)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.