What I want to achieve:
A combination of row selection and a filter based on selectizeInput() and keep the selected rows no matter if a filter is applied or not.
I tried to save the row IDs in a reactive value and update it for every selection, but I don't get it to work properly. It messes up with the row indices after the filter is applied.
In the example code below I also added a kind of group selection: so if one member of a group is selected the last column colors green. That's because I would like to establish a filter within the groups and if a selection occurs the whole group should be selected in the 'background'.
Overall is this the right way to go?
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
tags$span(icon('toggle-off'), style = "display: none;") ,
tags$head(tags$style(".fa-toggle-off {color:#9b1f23}")),
tags$head(tags$style(".fa-toggle-on {color:#a2ad00}")),
selectizeInput("choose_grp","choose grp", choices = c("No Filter" = "", 1:20), multiple = T),
DT::dataTableOutput('x1'), verbatimTextOutput('x2'), verbatimTextOutput('x3')),
server = function(input, output, session) {
# a sample data frame
N <- 100
res = data.frame(
v1 = paste0('test', 1:N),
v2 = ifelse(!duplicated(rep(1:20,each = 5)), rep(1:20,each = 5), NA),
v2_grp = rep(1:20,each = 5),
r_g = rep('r', N),
r_g_grp = rep('r', N),
v3 = ifelse(!duplicated(rep(1:20,each = 5)),
as.character(icon('toggle-off')), NA),
ID = 1: N,
stringsAsFactors = FALSE
)
# reactive values to store selected rows
sel_all <- reactiveValues(all = data.frame(ID = res$ID, sel = rep(F,N)))
save_sel_vals <- reactiveValues(a = c(), d = c())
# observer for reactive values to change preselected rows
observe({
res_old <- res
if (is.null(input$choose_grp)){
res <- res
} else if (any(input$choose_grp != "")){
res <- res[res$v2_grp %in% as.numeric(input$choose_grp),]
}
a_sel <- sel_all$all$sel[sel_all$all$ID %in% res$ID]
a <- data.frame(IDs = res$ID,
sel = a_sel)
if (is.null(input$x1_rows_selected)) {
a[, 'sel'] <- F
} else {
a[input$x1_rows_selected, 'sel'] <- T
a[- input$x1_rows_selected, 'sel'] <- F
}
sel_all$all$sel[sel_all$all$ID %in% a$IDs] <- a$sel
isolate(a2 <- sel_all$all$sel[sel_all$all$ID %in% a$IDs])
isolate(d <- input$x1_cell_clicked$row -1)
save_sel_vals$a <- a2
save_sel_vals$d <- d
})
# render the table containing shiny inputs
output$x1 = DT::renderDataTable({
sel_rows <- save_sel_vals$a
res$r_g[sel_rows] <- 'g'
res$r_g_grp <- ifelse(res$v2_grp %in% res$v2_grp[sel_rows], 'g', 'r')
res$v3 <- ifelse(!is.na(res$v3), ifelse(
(res$v2_grp %in% res$v2_grp[sel_rows]), as.character(icon('toggle-on')), as.character(icon('toggle-off'))),
NA)
if (is.null(input$choose_grp)){
res <- res
} else if (any(input$choose_grp != "")){
res <- res[res$v2_grp %in% as.numeric(input$choose_grp),]
}
datatable(res, extensions = c('Scroller'), escape = F,
selection = list(mode = "multiple", target= 'row', selected = (1:nrow(res))[sel_rows]),
options = list(scrollX = T,
autoWidth = F,
deferRender = TRUE,
scrollY = 500,
scroller = T,
paging = T
), callback = JS(paste0('table.row(',save_sel_vals$d,').scrollTo(false);'))
) %>%
formatStyle(
columns = c("v3"), valueColumns = 'r_g_grp',
target = 'cell',
backgroundColor = styleEqual(c('r','g'), c('#e1a593','#d8dea8'))
)
} , server = F
)
# print the values of inputs
output$x2 = renderPrint({
data.frame(selected_row = input$x1_rows_selected,
selected_grp = res$v2_grp[input$x1_rows_selected]
)
})
output$x3 = renderPrint({
sel_all$all[1:10,]
})
}
)
