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)
Created on 2021-04-30 by the reprex package (v2.0.0)