使用 DT 数据表将按钮的 javascript 功能移动到嵌入式按钮
Move javascript functionality of buttons to embedded buttons with DT datatable
与上一个问题相关，我一直在研究如何在数据表中的嵌入式按钮上获得 javascript 功能 运行。
我怀疑它与 javascript 的启动与按钮的呈现有关，但到目前为止我还没有弄清楚如何让嵌入式按钮的功能正常工作..
在下面的应用程序中，我给嵌入式按钮起了一个不同的名字，但是在应用程序中没有常规操作按钮的情况下测试它，并给嵌入式按钮一个相同的名称，javascript 似乎没有反应
library(shiny)
library(DT)
initComplete <- c(
"function(settings) {",
" var table = settings.oInstance.api();",
" var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
" var checkmark = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-ok\"></i></span>'",
" $('#SubmitRemoval').on('click', function(){",
" table.$('tr.selected').addClass('x');",
" table.$('tr.selected')",
" .each(function(){$(this).find('td').eq(1).html(cross);});",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
" });",
" $('#UndoRemoval').on('click', function(){",
" table.$('tr').removeClass('x');",
" table.$('tr')",
" .each(function(i){$(this).find('td').eq(1).html(checkmark);});",
" Shiny.setInputValue('excludedRows', null);",
" });",
"}"
)
callback <- "
var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'
var xrows = [];
table.on('preDraw', function(e, settings) {
var tbl = settings.oInstance.api();
var nrows = tbl.rows().count();
var rows = tbl.$('tr');
var some = false; var r = 0;
while(!some && r<nrows){
if($(rows[r]).hasClass('x')){
some = true
}
r++;
}
if(some){
xrows = [];
for(var i = 0; i < nrows; i++){
if($(rows[i]).hasClass('x')){
xrows.push(rows[i].getAttribute('id'));
}
}
}
}).on('draw.dt', function(){
for(var i=0; i<xrows.length; i++){
var row = $('#' + xrows[i]);
row.addClass('x').find('td').eq(1).html(cross);
}
xrows = [];
});
"
ui <- fluidPage(
tags$head(
tags$style(HTML(
".x { background-color: rgb(211,211,211) !important; font-style: italic}
table.dataTable tr.selected.x td { background-color: rgb(211,211,211) !important;}"
))
),
actionButton('SubmitRemoval', 'Exclude selected rows'),
actionButton('UndoRemoval', 'Include full data'),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = '<span style="color:red; font-size:18px"><i class="glyphicon glyphicon-ok"></i></span>',
mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
escape = -2,
callback = JS(callback),
extensions = c('Buttons', 'Scroller'),
options = list(
initComplete = JS(initComplete),
rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),
columnDefs = list(
list(visible = FALSE, targets = ncol(dat)),
list(className = "dt-center", targets = "_all")
),
dom = 'frtipB',
buttons = list('copy', 'csv',
list(
extend = "collection",
text = 'Deselect',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('SubmitRemovalEmb', true, {priority: 'event'});
}")
),
list(
extend = "collection",
text = 'Restore',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('UndoRemovalEmb', true, {priority: 'event'});
}")
)
)
)
)
})
proxy <- dataTableProxy("mytable")
observeEvent(input[["UndoRemoval"]], {
proxy %>% selectRows(NULL)
})
}
shinyApp(ui, server)
更新2
包含修改和更正的工作答案。根据最后的评论查看最后的收尾工作
library(shiny)
library(DT)
callback <- "
var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'
var xrows = [];
table.on('preDraw', function(e, settings) {
var tbl = settings.oInstance.api();
var nrows = tbl.rows().count();
var rows = tbl.$('tr');
var some = false; var r = 0;
while(!some && r<nrows){
if($(rows[r]).hasClass('x')){
some = true
}
r++;
}
if(some){
xrows = [];
for(var i = 0; i < nrows; i++){
if($(rows[i]).hasClass('x')){
xrows.push(rows[i].getAttribute('id'));
}
}
}
}).on('draw.dt', function(){
for(var i=0; i<xrows.length; i++){
var row = $('#' + xrows[i]);
row.addClass('x').find('td').eq(1).html(cross);
}
xrows = [];
});
"
ui <- fluidPage(
tags$head(
tags$style(HTML(
".x { font-style: italic}"
))
),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = '<span style="color:red; font-size:18px"><i class="glyphicon glyphicon-ok"></i></span>',
mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
escape = -2,
callback = JS(callback),
extensions = c('Buttons', 'Scroller'),
options = list(
rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),
columnDefs = list(
list(visible = FALSE, targets = ncol(dat)),
list(className = "dt-center", targets = "_all")
),
dom = 'B',
buttons = list('copy', 'csv',
list(
extend = "collection",
text = 'Deselect',
action = DT::JS(
c(
"function ( e, table, node, config ) {",
" var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
" table.$('tr.selected').addClass('x');",
" table.$('tr.selected')",
" .each(function(){$(this).find('td').eq(1).html(cross);}).removeClass('selected');",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
"}"
)
)
),
list(
extend = "collection",
text = 'Restore',
action = DT::JS(
c(
"function ( e, table, node, config ) {",
" var checkmark = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-ok\"></i></span>'",
" table.$('tr')",
" .each(function(i){$(this).find('td').eq(1).html(checkmark);});",
" table.$('tr').removeClass('x').removeClass('selected');",
" Shiny.setInputValue('excludedRows', null);",
" }"
)
)
)
)
)
)
})
proxy <- dataTableProxy("mytable")
observeEvent(input[['excludedRows']], {
print(input[['excludedRows']])}, ignoreInit = T)
}
shinyApp(ui, server)
ps 评论 select:
我完全删除了 css，除了斜体部分。我的意思是，在单击取消select 或恢复后，我想取消select 单击的行，在此图像中以蓝色显示（单击它们时它们的颜色）
更新问题
我正在尝试更改 Selected 列以保存 T 和 F 值，我想我设法使 remove 和“恢复代码”正常工作有了那个，但我不确定如何让新的渲染功能工作。到目前为止我所拥有的是：
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' return "<span style=\\"color:red; font-size:18px\\"><i class=\\"glyphicon glyphicon-remove\\"></i></span>";',
' } else {',
' return "<span style=\\"color:red; font-size:18px\\"><i class=\\"glyphicon glyphicon-ok\\"></i></span>";',
' }',
'}'
)
问题是我不知道如何更改明显不正确的 IF 语句：' if(type === "display"){',
按钮操作函数 (function(e,dt,node,config)) 的参数 dt 是主机 DataTable 的 DataTables 实例 API: https://datatables.net/reference/option/buttons.buttons.action
在initComplete函数function(settings)中，这个对象是settings.oInstance.api()，在JS代码中命名为table(var table = settings.oInstance.api();)。
所以将function(e,dt,node,config)替换为function(e,table,node,config)，并将JS代码移动到按钮动作函数体中：
action = DT::JS(
c(
"function ( e, table, node, config ) {",
" var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
" table.$('tr.selected').addClass('x');",
" table.$('tr.selected')",
" .each(function(){$(this).find('td').eq(1).html(cross);});",
"}"
)
)
编辑
这是更新后的解决方案的完整代码：
library(shiny)
library(DT)
removal <- c(
"function(e, table, node, config) {",
" table.$('tr.selected').addClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('remove');",
" });",
" table.rows().deselect();",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
"}"
)
restore <- c(
"function(e, table, node, config) {",
" table.$('tr').removeClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('ok');",
" });",
" Shiny.setInputValue('excludedRows', null);",
"}"
)
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' return "<span style=\\"color:red; font-size:18px\\"><i class=\\"glyphicon glyphicon-" + data + "\\"></i></span>";',
' } else {',
' return data;',
' }',
'}'
)
ui <- fluidPage(
tags$head(
tags$style(HTML(
".x { color: rgb(211,211,211); font-style: italic; }"
))
),
fluidRow(
column(
6,
tags$label("Excluded rows"),
verbatimTextOutput("excludedRows")
),
column(
6,
tags$label("Included rows"),
verbatimTextOutput("includedRows")
)
),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = "ok", mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
extensions = c("Select", "Buttons"),
options = list(
rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),
columnDefs = list(
list(visible = FALSE, targets = ncol(dat)),
list(className = "dt-center", targets = "_all"),
list(targets = 1, render = JS(render))
),
dom = "B",
buttons = list("copy", "csv",
list(
extend = "collection",
text = 'Deselect',
action = JS(removal)
),
list(
extend = "collection",
text = 'Restore',
action = JS(restore)
)
)
)
)
}, server = FALSE)
output$excludedRows <- renderPrint({
input[["excludedRows"]]
})
output$includedRows <- renderPrint({
setdiff(1:nrow(dat), input[["excludedRows"]])
})
}
shinyApp(ui, server)
"Deselect" 来自闪亮的服务器：示例
library(shiny)
library(DT)
library(shinyjs)
js <- paste(
"var table = $('#mytable').find('table').DataTable();",
"var rowsindices = [%s];",
"for(var i=0; i<rowsindices.length; ++i){",
" var idx = rowsindices[i];",
" table.cell(idx, 1).data('remove');",
" table.row(idx).select();",
"}",
"$('.dt-button.buttons-collection').eq(0).click();",
sep = "\n"
)
removal <- c(
"function(e, table, node, config) {",
" table.$('tr.selected').addClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('remove');",
" });",
" table.rows().deselect();",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
"}"
)
restore <- c(
"function(e, table, node, config) {",
" table.$('tr').removeClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('ok');",
" });",
" Shiny.setInputValue('excludedRows', null);",
"}"
)
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' return "<span style=\\"color:red; font-size:18px\\"><i class=\\"glyphicon glyphicon-" + data + "\\"></i></span>";',
' } else {',
' return data;',
' }',
'}'
)
ui <- fluidPage(
useShinyjs(),
tags$head(
tags$style(HTML(
".x { color: rgb(211,211,211); font-style: italic; }"
))
),
fluidRow(
column(
6,
tags$label("Excluded rows"),
verbatimTextOutput("excludedRows")
),
column(
6,
tags$label("Included rows"),
verbatimTextOutput("includedRows")
)
),
br(),
actionButton("go", "Deselect rows 1, 2, 3"),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = "ok", mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
extensions = c("Select", "Buttons"),
options = list(
rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),
columnDefs = list(
list(visible = FALSE, targets = ncol(dat)),
list(className = "dt-center", targets = "_all"),
list(targets = 1, render = JS(render))
),
dom = "B",
buttons = list("copy", "csv",
list(
extend = "collection",
text = 'Deselect',
action = JS(removal)
),
list(
extend = "collection",
text = 'Restore',
action = JS(restore)
)
)
)
)
}, server = FALSE)
output$excludedRows <- renderPrint({
input[["excludedRows"]]
})
output$includedRows <- renderPrint({
setdiff(1:nrow(dat), input[["excludedRows"]])
})
observeEvent(input[["go"]], {
rows <- c(1,2,3) - 1
runjs(sprintf(js, paste0(rows, collapse=",")))
})
}
shinyApp(ui, server)
与上一个问题相关，我一直在研究如何在数据表中的嵌入式按钮上获得 javascript 功能 运行。 我怀疑它与 javascript 的启动与按钮的呈现有关，但到目前为止我还没有弄清楚如何让嵌入式按钮的功能正常工作..
在下面的应用程序中，我给嵌入式按钮起了一个不同的名字，但是在应用程序中没有常规操作按钮的情况下测试它，并给嵌入式按钮一个相同的名称，javascript 似乎没有反应
library(shiny)
library(DT)
initComplete <- c(
"function(settings) {",
" var table = settings.oInstance.api();",
" var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
" var checkmark = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-ok\"></i></span>'",
" $('#SubmitRemoval').on('click', function(){",
" table.$('tr.selected').addClass('x');",
" table.$('tr.selected')",
" .each(function(){$(this).find('td').eq(1).html(cross);});",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
" });",
" $('#UndoRemoval').on('click', function(){",
" table.$('tr').removeClass('x');",
" table.$('tr')",
" .each(function(i){$(this).find('td').eq(1).html(checkmark);});",
" Shiny.setInputValue('excludedRows', null);",
" });",
"}"
)
callback <- "
var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'
var xrows = [];
table.on('preDraw', function(e, settings) {
var tbl = settings.oInstance.api();
var nrows = tbl.rows().count();
var rows = tbl.$('tr');
var some = false; var r = 0;
while(!some && r<nrows){
if($(rows[r]).hasClass('x')){
some = true
}
r++;
}
if(some){
xrows = [];
for(var i = 0; i < nrows; i++){
if($(rows[i]).hasClass('x')){
xrows.push(rows[i].getAttribute('id'));
}
}
}
}).on('draw.dt', function(){
for(var i=0; i<xrows.length; i++){
var row = $('#' + xrows[i]);
row.addClass('x').find('td').eq(1).html(cross);
}
xrows = [];
});
"
ui <- fluidPage(
tags$head(
tags$style(HTML(
".x { background-color: rgb(211,211,211) !important; font-style: italic}
table.dataTable tr.selected.x td { background-color: rgb(211,211,211) !important;}"
))
),
actionButton('SubmitRemoval', 'Exclude selected rows'),
actionButton('UndoRemoval', 'Include full data'),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = '<span style="color:red; font-size:18px"><i class="glyphicon glyphicon-ok"></i></span>',
mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
escape = -2,
callback = JS(callback),
extensions = c('Buttons', 'Scroller'),
options = list(
initComplete = JS(initComplete),
rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),
columnDefs = list(
list(visible = FALSE, targets = ncol(dat)),
list(className = "dt-center", targets = "_all")
),
dom = 'frtipB',
buttons = list('copy', 'csv',
list(
extend = "collection",
text = 'Deselect',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('SubmitRemovalEmb', true, {priority: 'event'});
}")
),
list(
extend = "collection",
text = 'Restore',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('UndoRemovalEmb', true, {priority: 'event'});
}")
)
)
)
)
})
proxy <- dataTableProxy("mytable")
observeEvent(input[["UndoRemoval"]], {
proxy %>% selectRows(NULL)
})
}
shinyApp(ui, server)
更新2 包含修改和更正的工作答案。根据最后的评论查看最后的收尾工作
library(shiny)
library(DT)
callback <- "
var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'
var xrows = [];
table.on('preDraw', function(e, settings) {
var tbl = settings.oInstance.api();
var nrows = tbl.rows().count();
var rows = tbl.$('tr');
var some = false; var r = 0;
while(!some && r<nrows){
if($(rows[r]).hasClass('x')){
some = true
}
r++;
}
if(some){
xrows = [];
for(var i = 0; i < nrows; i++){
if($(rows[i]).hasClass('x')){
xrows.push(rows[i].getAttribute('id'));
}
}
}
}).on('draw.dt', function(){
for(var i=0; i<xrows.length; i++){
var row = $('#' + xrows[i]);
row.addClass('x').find('td').eq(1).html(cross);
}
xrows = [];
});
"
ui <- fluidPage(
tags$head(
tags$style(HTML(
".x { font-style: italic}"
))
),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = '<span style="color:red; font-size:18px"><i class="glyphicon glyphicon-ok"></i></span>',
mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
escape = -2,
callback = JS(callback),
extensions = c('Buttons', 'Scroller'),
options = list(
rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),
columnDefs = list(
list(visible = FALSE, targets = ncol(dat)),
list(className = "dt-center", targets = "_all")
),
dom = 'B',
buttons = list('copy', 'csv',
list(
extend = "collection",
text = 'Deselect',
action = DT::JS(
c(
"function ( e, table, node, config ) {",
" var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
" table.$('tr.selected').addClass('x');",
" table.$('tr.selected')",
" .each(function(){$(this).find('td').eq(1).html(cross);}).removeClass('selected');",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
"}"
)
)
),
list(
extend = "collection",
text = 'Restore',
action = DT::JS(
c(
"function ( e, table, node, config ) {",
" var checkmark = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-ok\"></i></span>'",
" table.$('tr')",
" .each(function(i){$(this).find('td').eq(1).html(checkmark);});",
" table.$('tr').removeClass('x').removeClass('selected');",
" Shiny.setInputValue('excludedRows', null);",
" }"
)
)
)
)
)
)
})
proxy <- dataTableProxy("mytable")
observeEvent(input[['excludedRows']], {
print(input[['excludedRows']])}, ignoreInit = T)
}
shinyApp(ui, server)
ps 评论 select: 我完全删除了 css，除了斜体部分。我的意思是，在单击取消select 或恢复后，我想取消select 单击的行，在此图像中以蓝色显示（单击它们时它们的颜色）
更新问题
我正在尝试更改 Selected 列以保存 T 和 F 值，我想我设法使 remove 和“恢复代码”正常工作有了那个，但我不确定如何让新的渲染功能工作。到目前为止我所拥有的是：
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' return "<span style=\\"color:red; font-size:18px\\"><i class=\\"glyphicon glyphicon-remove\\"></i></span>";',
' } else {',
' return "<span style=\\"color:red; font-size:18px\\"><i class=\\"glyphicon glyphicon-ok\\"></i></span>";',
' }',
'}'
)
问题是我不知道如何更改明显不正确的 IF 语句：' if(type === "display"){',
按钮操作函数 (function(e,dt,node,config)) 的参数 dt 是主机 DataTable 的 DataTables 实例 API: https://datatables.net/reference/option/buttons.buttons.action
在initComplete函数function(settings)中，这个对象是settings.oInstance.api()，在JS代码中命名为table(var table = settings.oInstance.api();)。
所以将function(e,dt,node,config)替换为function(e,table,node,config)，并将JS代码移动到按钮动作函数体中：
action = DT::JS(
c(
"function ( e, table, node, config ) {",
" var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
" table.$('tr.selected').addClass('x');",
" table.$('tr.selected')",
" .each(function(){$(this).find('td').eq(1).html(cross);});",
"}"
)
)
编辑
这是更新后的解决方案的完整代码：
library(shiny)
library(DT)
removal <- c(
"function(e, table, node, config) {",
" table.$('tr.selected').addClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('remove');",
" });",
" table.rows().deselect();",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
"}"
)
restore <- c(
"function(e, table, node, config) {",
" table.$('tr').removeClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('ok');",
" });",
" Shiny.setInputValue('excludedRows', null);",
"}"
)
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' return "<span style=\\"color:red; font-size:18px\\"><i class=\\"glyphicon glyphicon-" + data + "\\"></i></span>";',
' } else {',
' return data;',
' }',
'}'
)
ui <- fluidPage(
tags$head(
tags$style(HTML(
".x { color: rgb(211,211,211); font-style: italic; }"
))
),
fluidRow(
column(
6,
tags$label("Excluded rows"),
verbatimTextOutput("excludedRows")
),
column(
6,
tags$label("Included rows"),
verbatimTextOutput("includedRows")
)
),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = "ok", mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
extensions = c("Select", "Buttons"),
options = list(
rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),
columnDefs = list(
list(visible = FALSE, targets = ncol(dat)),
list(className = "dt-center", targets = "_all"),
list(targets = 1, render = JS(render))
),
dom = "B",
buttons = list("copy", "csv",
list(
extend = "collection",
text = 'Deselect',
action = JS(removal)
),
list(
extend = "collection",
text = 'Restore',
action = JS(restore)
)
)
)
)
}, server = FALSE)
output$excludedRows <- renderPrint({
input[["excludedRows"]]
})
output$includedRows <- renderPrint({
setdiff(1:nrow(dat), input[["excludedRows"]])
})
}
shinyApp(ui, server)
"Deselect" 来自闪亮的服务器：示例
library(shiny)
library(DT)
library(shinyjs)
js <- paste(
"var table = $('#mytable').find('table').DataTable();",
"var rowsindices = [%s];",
"for(var i=0; i<rowsindices.length; ++i){",
" var idx = rowsindices[i];",
" table.cell(idx, 1).data('remove');",
" table.row(idx).select();",
"}",
"$('.dt-button.buttons-collection').eq(0).click();",
sep = "\n"
)
removal <- c(
"function(e, table, node, config) {",
" table.$('tr.selected').addClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('remove');",
" });",
" table.rows().deselect();",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
"}"
)
restore <- c(
"function(e, table, node, config) {",
" table.$('tr').removeClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('ok');",
" });",
" Shiny.setInputValue('excludedRows', null);",
"}"
)
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' return "<span style=\\"color:red; font-size:18px\\"><i class=\\"glyphicon glyphicon-" + data + "\\"></i></span>";',
' } else {',
' return data;',
' }',
'}'
)
ui <- fluidPage(
useShinyjs(),
tags$head(
tags$style(HTML(
".x { color: rgb(211,211,211); font-style: italic; }"
))
),
fluidRow(
column(
6,
tags$label("Excluded rows"),
verbatimTextOutput("excludedRows")
),
column(
6,
tags$label("Included rows"),
verbatimTextOutput("includedRows")
)
),
br(),
actionButton("go", "Deselect rows 1, 2, 3"),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = "ok", mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
extensions = c("Select", "Buttons"),
options = list(
rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),
columnDefs = list(
list(visible = FALSE, targets = ncol(dat)),
list(className = "dt-center", targets = "_all"),
list(targets = 1, render = JS(render))
),
dom = "B",
buttons = list("copy", "csv",
list(
extend = "collection",
text = 'Deselect',
action = JS(removal)
),
list(
extend = "collection",
text = 'Restore',
action = JS(restore)
)
)
)
)
}, server = FALSE)
output$excludedRows <- renderPrint({
input[["excludedRows"]]
})
output$includedRows <- renderPrint({
setdiff(1:nrow(dat), input[["excludedRows"]])
})
observeEvent(input[["go"]], {
rows <- c(1,2,3) - 1
runjs(sprintf(js, paste0(rows, collapse=",")))
})
}
shinyApp(ui, server)