将选中的图标添加到 DT shiny 中的选定行
Add checked icon to selected rows in DT shiny
我在闪亮的应用程序中有一个 DT table，其背景颜色设置为与特定值匹配。我还在 table 中使用 selected 行来控制应用程序的其他部分。现在我的问题是要明确哪些行是 selected.
通常 selected table 中的行会更改背景颜色，但我没有此选项，因为我已经设置了背景颜色并且不想更改它。更改 selected 行的前景色（字体颜色）不是最佳选择，因为这不明显且不直观。
现在我正在使 selected 行与未selected 行具有不同的不透明度，这在一定程度上起作用但仍然不是最佳的。
一种方法是在 selected 行中添加一些选中的图标。请注意，我不想要真正的复选框输入，因为这会导致用户单击该复选框，而我认为只需单击 select.
行会更容易
有一些示例可以显示 DT table 中的 html 内容，但是这将意味着按行 selection 动态更改 table 内容，这是不可接受的table 到我的应用程序，因为每次 table 内容更改都会触发 table 刷新，这会重置行 selection 并进入循环。
我认为应该可以使用 js 更改 selected 行 css class，从而为它们添加选中的图标。我看到 this question 有点相似，但是这个例子对我来说很难理解。
更新：@Stéphane Laurent 的 完全解决了我的问题。我之前进行了如此广泛的搜索，但没有找到这个。
更新 2：我的用例更复杂，我在采用这种方法时遇到了问题。我需要 2 个控件 tables，我正在根据单选按钮控件切换它们。使用 table 的动态呈现，排除的状态在每次切换时都会重置。以前我使用 DT 行 selection 没有这个问题。
看下面的例子，排除table中的一些行 1，切换到table 2，再切换回来，排除状态恢复。
library(shiny)
library(DT)
# DT checked js ----
rowNames <- FALSE # whether to show row names in the table
colIndex <- as.integer(rowNames)
# making variants since we have two table. not worth a function since only two instances. main changes are function name and shiny input id excludedRows
callback1 <- c(
sprintf("table.on('click', 'td:nth-child(%d)', function(){", colIndex+1),
" var td = this;",
" var cell = table.cell(td);",
" if(cell.data() === 'ok'){",
" cell.data('remove');",
" } else {",
" cell.data('ok');",
" }",
" var $row = $(td).closest('tr');",
" $row.toggleClass('excluded');",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('excluded')){",
" excludedRows.push(parseInt($(row).attr('id').split('_')[1]));",
" }",
" });",
" Shiny.setInputValue('excludedRows1', excludedRows);",
"})"
)
callback2 <- c(
sprintf("table.on('click', 'td:nth-child(%d)', function(){", colIndex+1),
" var td = this;",
" var cell = table.cell(td);",
" if(cell.data() === 'ok'){",
" cell.data('remove');",
" } else {",
" cell.data('ok');",
" }",
" var $row = $(td).closest('tr');",
" $row.toggleClass('excluded');",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('excluded')){",
" excludedRows.push(parseInt($(row).attr('id').split('_')[1]));",
" }",
" });",
" Shiny.setInputValue('excludedRows2', excludedRows);",
"})"
)
# for select all, not using it now
# restore <- c(
# "function(e, table, node, config) {",
# " table.$('tr').removeClass('excluded').each(function(){",
# sprintf(" var td = $(this).find('td').eq(%d)[0];", colIndex),
# " var cell = table.cell(td);",
# " cell.data('ok');",
# " });",
# " Shiny.setInputValue('excludedRows', null);",
# "}"
# )
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' var color = data === "ok" ? "#027eac" : "gray";',
' return "<span style=\\"color:" + color +',
' "; font-size:18px\\"><i class=\\"glyphicon glyphicon-" +',
' data + "\\"></i></span>";',
' } else {',
' return data;',
' }',
'}'
)
# test app ----
ui <- fluidPage(
tags$head(
tags$style(HTML(
".excluded { color: gray; font-style: italic; }"
))
),
fluidRow(
column(
6,
tags$label("Excluded rows Table 1"),
verbatimTextOutput("excludedRows1"),
tags$label("Excluded rows Table 2"),
verbatimTextOutput("excludedRows2")
),
column(
6,
tags$label("Included rows"),
verbatimTextOutput("includedRows1"),
verbatimTextOutput("includedRows2")
)
),
br(),
radioButtons("select_table", label = "Select table", choices = c("1", "2"), inline = TRUE),
uiOutput("control_table_ui")
# tabBox(tabPanel("1", DTOutput("mytable1")),
# tabPanel("2", DTOutput("mytable2")))
)
server <- function(input, output,session) {
output$control_table_ui <- renderUI({
if (input$select_table == "1") {
column(12, offset = 0, DTOutput("mytable1"))
} else {
column(12, offset = 0, DTOutput("mytable2"))
}
})
dt <- cbind(On = "ok", mtcars[1:6,], id = paste0("row_",1:6))
row_colors <- rep(c("red", "blue", "green"), 2)
names(row_colors) <- dt$id
output[["mytable1"]] <- renderDT({
datatable(dt, caption = "table 1",
rownames = rowNames, extensions = c("Select"),
selection = "none", callback = JS(callback1),
options = list(
# pageLength = 3,
sort = FALSE,
rowId = JS(sprintf("function(data){return data[%d];}",
ncol(dt)-1+colIndex)),
columnDefs = list(
list(visible = FALSE, targets = ncol(dt)-1+colIndex),
list(className = "dt-center", targets = "_all"),
list(className = "notselectable", targets = colIndex),
list(targets = colIndex, render = JS(render))
),
dom = "t",
# buttons = list(list(
# extend = "collection",
# text = 'Select All',
# action = JS(restore)
# )
# ),
select = list(style = "single", selector = "td:not(.notselectable)")
# select = list(style = 'os', # set 'os' select style so that ctrl/shift + click in enabled
# items = 'row') # items can be cell, row or column
)
) %>%
formatStyle("id", target = "row",
backgroundColor = styleEqual(dt$id, row_colors))
}, server = FALSE)
output[["mytable2"]] <- renderDT({
datatable(dt, caption = "table 2",
rownames = rowNames, extensions = c("Select"),
selection = "none", callback = JS(callback2),
options = list(
# pageLength = 3,
rowId = JS(sprintf("function(data){return data[%d];}",
ncol(dt)-1+colIndex)),
columnDefs = list(
list(visible = FALSE, targets = ncol(dt)-1+colIndex),
list(className = "dt-center", targets = "_all"),
list(className = "notselectable", targets = colIndex),
list(targets = colIndex, render = JS(render))
),
dom = "t",
# buttons = list(list(
# extend = "collection",
# text = 'Select All',
# action = JS(restore)
# )
# ),
select = list(style = "single", selector = "td:not(.notselectable)")
)
) %>%
formatStyle("id", target = "row",
backgroundColor = styleEqual(dt$id, row_colors))
}, server = FALSE)
output$excludedRows1 <- renderPrint({
input[["excludedRows1"]]
})
output$excludedRows2 <- renderPrint({
input[["excludedRows2"]]
})
output$includedRows1 <- renderPrint({
setdiff(1:nrow(dt), input[["excludedRows1"]])
})
}
shinyApp(ui, server)
更新 3：根据@Stéphane Laurent 的建议，使用 conditionalPanel 解决了问题。虽然它比 renderUI 慢一点，但是它可以工作。
感谢@StéphaneLaurent 的回答，这是一个很棒的基于 js 的解决方案，解决了我 95% 的需求。但是我需要一个按钮来清除所有选择并且由于我的 js 技能有限而无法编写那个按钮。我也忘记了重要的 server=FALSE 参数，因此遇到了排序丢失选择的问题。因此我切换回原来的行选择机制。
我曾经尝试通过行选择来修改 table，但这会触发反应性事件循环。后来我意识到我只需要改变视图，而不是底层数据，改变视图完全可以通过 css 规则。
选中the great example here，more icons示例可以根据复选框的选择显示不同的图标。通过检查 css 规则，我发现这两个图标一直都在那里，只是 css 规则因选择状态而异。
所以我想出了这个方案，它使用了DT中内置的行选择和一些css规则，这样你仍然拥有DT中行选择控制的所有功能，而不需要js代码，一切都由 css.
实现
library(shiny)
library(DT)
library(data.table)
ui <- fluidPage(
tags$head(
tags$style(HTML("
.selected .table-icon-yes {
opacity: 1;
display: inline-block;
color: #3c763d;
}
.table-icon-yes {
opacity: 0;
display: none;
}
.selected .table-icon-no {
opacity: 0;
display: none;
}
.table-icon-no {
opacity: 1;
display: inline-block;
color: #999;
}
"))
),
DTOutput("table")
)
icon_col <- tagList(span(class = "table-icon-yes", icon("ok", lib = "glyphicon")),
span(class = "table-icon-no", icon("remove", lib = "glyphicon")))
server <- function(input, output, session) {
output$table <- renderDT({
dt <- data.table(iris)
dt[, Selected := as.character(icon_col)]
setcolorder(dt, c(ncol(dt), 1:(ncol(dt) - 1)))
datatable(dt, escape = FALSE)
})
}
shinyApp(ui = ui, server = server)
我在闪亮的应用程序中有一个 DT table，其背景颜色设置为与特定值匹配。我还在 table 中使用 selected 行来控制应用程序的其他部分。现在我的问题是要明确哪些行是 selected.
通常 selected table 中的行会更改背景颜色，但我没有此选项，因为我已经设置了背景颜色并且不想更改它。更改 selected 行的前景色（字体颜色）不是最佳选择，因为这不明显且不直观。
现在我正在使 selected 行与未selected 行具有不同的不透明度，这在一定程度上起作用但仍然不是最佳的。
一种方法是在 selected 行中添加一些选中的图标。请注意，我不想要真正的复选框输入，因为这会导致用户单击该复选框，而我认为只需单击 select.
行会更容易有一些示例可以显示 DT table 中的 html 内容，但是这将意味着按行 selection 动态更改 table 内容，这是不可接受的table 到我的应用程序，因为每次 table 内容更改都会触发 table 刷新，这会重置行 selection 并进入循环。
我认为应该可以使用 js 更改 selected 行 css class，从而为它们添加选中的图标。我看到 this question 有点相似，但是这个例子对我来说很难理解。
更新：@Stéphane Laurent 的
更新 2：我的用例更复杂，我在采用这种方法时遇到了问题。我需要 2 个控件 tables，我正在根据单选按钮控件切换它们。使用 table 的动态呈现，排除的状态在每次切换时都会重置。以前我使用 DT 行 selection 没有这个问题。
看下面的例子，排除table中的一些行 1，切换到table 2，再切换回来，排除状态恢复。
library(shiny)
library(DT)
# DT checked js ----
rowNames <- FALSE # whether to show row names in the table
colIndex <- as.integer(rowNames)
# making variants since we have two table. not worth a function since only two instances. main changes are function name and shiny input id excludedRows
callback1 <- c(
sprintf("table.on('click', 'td:nth-child(%d)', function(){", colIndex+1),
" var td = this;",
" var cell = table.cell(td);",
" if(cell.data() === 'ok'){",
" cell.data('remove');",
" } else {",
" cell.data('ok');",
" }",
" var $row = $(td).closest('tr');",
" $row.toggleClass('excluded');",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('excluded')){",
" excludedRows.push(parseInt($(row).attr('id').split('_')[1]));",
" }",
" });",
" Shiny.setInputValue('excludedRows1', excludedRows);",
"})"
)
callback2 <- c(
sprintf("table.on('click', 'td:nth-child(%d)', function(){", colIndex+1),
" var td = this;",
" var cell = table.cell(td);",
" if(cell.data() === 'ok'){",
" cell.data('remove');",
" } else {",
" cell.data('ok');",
" }",
" var $row = $(td).closest('tr');",
" $row.toggleClass('excluded');",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('excluded')){",
" excludedRows.push(parseInt($(row).attr('id').split('_')[1]));",
" }",
" });",
" Shiny.setInputValue('excludedRows2', excludedRows);",
"})"
)
# for select all, not using it now
# restore <- c(
# "function(e, table, node, config) {",
# " table.$('tr').removeClass('excluded').each(function(){",
# sprintf(" var td = $(this).find('td').eq(%d)[0];", colIndex),
# " var cell = table.cell(td);",
# " cell.data('ok');",
# " });",
# " Shiny.setInputValue('excludedRows', null);",
# "}"
# )
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' var color = data === "ok" ? "#027eac" : "gray";',
' return "<span style=\\"color:" + color +',
' "; font-size:18px\\"><i class=\\"glyphicon glyphicon-" +',
' data + "\\"></i></span>";',
' } else {',
' return data;',
' }',
'}'
)
# test app ----
ui <- fluidPage(
tags$head(
tags$style(HTML(
".excluded { color: gray; font-style: italic; }"
))
),
fluidRow(
column(
6,
tags$label("Excluded rows Table 1"),
verbatimTextOutput("excludedRows1"),
tags$label("Excluded rows Table 2"),
verbatimTextOutput("excludedRows2")
),
column(
6,
tags$label("Included rows"),
verbatimTextOutput("includedRows1"),
verbatimTextOutput("includedRows2")
)
),
br(),
radioButtons("select_table", label = "Select table", choices = c("1", "2"), inline = TRUE),
uiOutput("control_table_ui")
# tabBox(tabPanel("1", DTOutput("mytable1")),
# tabPanel("2", DTOutput("mytable2")))
)
server <- function(input, output,session) {
output$control_table_ui <- renderUI({
if (input$select_table == "1") {
column(12, offset = 0, DTOutput("mytable1"))
} else {
column(12, offset = 0, DTOutput("mytable2"))
}
})
dt <- cbind(On = "ok", mtcars[1:6,], id = paste0("row_",1:6))
row_colors <- rep(c("red", "blue", "green"), 2)
names(row_colors) <- dt$id
output[["mytable1"]] <- renderDT({
datatable(dt, caption = "table 1",
rownames = rowNames, extensions = c("Select"),
selection = "none", callback = JS(callback1),
options = list(
# pageLength = 3,
sort = FALSE,
rowId = JS(sprintf("function(data){return data[%d];}",
ncol(dt)-1+colIndex)),
columnDefs = list(
list(visible = FALSE, targets = ncol(dt)-1+colIndex),
list(className = "dt-center", targets = "_all"),
list(className = "notselectable", targets = colIndex),
list(targets = colIndex, render = JS(render))
),
dom = "t",
# buttons = list(list(
# extend = "collection",
# text = 'Select All',
# action = JS(restore)
# )
# ),
select = list(style = "single", selector = "td:not(.notselectable)")
# select = list(style = 'os', # set 'os' select style so that ctrl/shift + click in enabled
# items = 'row') # items can be cell, row or column
)
) %>%
formatStyle("id", target = "row",
backgroundColor = styleEqual(dt$id, row_colors))
}, server = FALSE)
output[["mytable2"]] <- renderDT({
datatable(dt, caption = "table 2",
rownames = rowNames, extensions = c("Select"),
selection = "none", callback = JS(callback2),
options = list(
# pageLength = 3,
rowId = JS(sprintf("function(data){return data[%d];}",
ncol(dt)-1+colIndex)),
columnDefs = list(
list(visible = FALSE, targets = ncol(dt)-1+colIndex),
list(className = "dt-center", targets = "_all"),
list(className = "notselectable", targets = colIndex),
list(targets = colIndex, render = JS(render))
),
dom = "t",
# buttons = list(list(
# extend = "collection",
# text = 'Select All',
# action = JS(restore)
# )
# ),
select = list(style = "single", selector = "td:not(.notselectable)")
)
) %>%
formatStyle("id", target = "row",
backgroundColor = styleEqual(dt$id, row_colors))
}, server = FALSE)
output$excludedRows1 <- renderPrint({
input[["excludedRows1"]]
})
output$excludedRows2 <- renderPrint({
input[["excludedRows2"]]
})
output$includedRows1 <- renderPrint({
setdiff(1:nrow(dt), input[["excludedRows1"]])
})
}
shinyApp(ui, server)
更新 3：根据@Stéphane Laurent 的建议，使用 conditionalPanel 解决了问题。虽然它比 renderUI 慢一点，但是它可以工作。
感谢@StéphaneLaurent 的回答，这是一个很棒的基于 js 的解决方案，解决了我 95% 的需求。但是我需要一个按钮来清除所有选择并且由于我的 js 技能有限而无法编写那个按钮。我也忘记了重要的 server=FALSE 参数，因此遇到了排序丢失选择的问题。因此我切换回原来的行选择机制。
我曾经尝试通过行选择来修改 table，但这会触发反应性事件循环。后来我意识到我只需要改变视图，而不是底层数据，改变视图完全可以通过 css 规则。
选中the great example here，more icons示例可以根据复选框的选择显示不同的图标。通过检查 css 规则，我发现这两个图标一直都在那里，只是 css 规则因选择状态而异。
所以我想出了这个方案，它使用了DT中内置的行选择和一些css规则，这样你仍然拥有DT中行选择控制的所有功能，而不需要js代码，一切都由 css.
实现library(shiny)
library(DT)
library(data.table)
ui <- fluidPage(
tags$head(
tags$style(HTML("
.selected .table-icon-yes {
opacity: 1;
display: inline-block;
color: #3c763d;
}
.table-icon-yes {
opacity: 0;
display: none;
}
.selected .table-icon-no {
opacity: 0;
display: none;
}
.table-icon-no {
opacity: 1;
display: inline-block;
color: #999;
}
"))
),
DTOutput("table")
)
icon_col <- tagList(span(class = "table-icon-yes", icon("ok", lib = "glyphicon")),
span(class = "table-icon-no", icon("remove", lib = "glyphicon")))
server <- function(input, output, session) {
output$table <- renderDT({
dt <- data.table(iris)
dt[, Selected := as.character(icon_col)]
setcolorder(dt, c(ncol(dt), 1:(ncol(dt) - 1)))
datatable(dt, escape = FALSE)
})
}
shinyApp(ui = ui, server = server)