【发布时间】：2018-05-28 13:40:29
【问题描述】：
我想要达到的目标：
基于selectizeInput() 的行选择和过滤器的组合，无论是否应用过滤器，都保留选定的行。
我尝试将行 ID 保存在反应值中并为每个选择更新它，但我没有让它正常工作。应用过滤器后，它会与行索引混淆。
在下面的示例代码中，我还添加了一种组选择：因此，如果选择了组中的一个成员，则最后一列颜色为绿色。那是因为我想在组内建立一个过滤器，如果发生选择，则应该在“背景”中选择整个组。
总的来说，这是正确的方法吗？
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,]
})
}
)
【问题讨论】：