在 R DT(数据表)中以斜体和红色字体格式化行向量 [英] Format a vector of rows in italic and red font in R DT (datatable)
本文介绍了在 R DT(数据表)中以斜体和红色字体格式化行向量的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
有点类似于这个问题:
不确定这是否是正确的方法，但我的想法是同时使用两者values$selected_rows 和 values$removed_rows，其中第一个保存选择直到它被提交，如果用户决定，removed 保存选择删除的潜在增长的行列表在另一个提交中删除更多行
removed_rows 然后也是需要设置样式的行列表(以斜体显示为灰色)
图书馆(闪亮)图书馆(DT)ui <-流体页面(actionButton('SubmitRemoval', '排除选中的行'),actionButton('UndoRemoval', '包括完整数据'),逐字文本输出('打印结果')，DT::dataTableOutput('mytable'))服务器 <- 功能(输入，输出，会话){值 <-reactiveValues()观察({values$selected_rows <- input$mytable_rows_selected})观察事件(输入$提交移除，{values$removed_rows <- c(values$removed_rows,input$mytable_rows_selected)dataTableProxy('mytable') %>% selectRows(NULL)values$selected_rows <- NULLremoveTab("tabs", "mytable")})Remaining_mtcars <- 反应式({请求(值$removed_rows)mtcarsR <- mtcars[-c(values$removed_rows), ]mtcarsR})output$Printresult <- renderText({ nrow(Remaining_mtcars()) })观察事件(输入$UndoRemoval，{values$removed_rows <- NULL})输出$mytable <- DT::renderDataTable({DT::datatable(mtcars,extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),选项 = 列表(页面长度 = 25，selection = c('multiple'),dom = 'frtipB'))})}运行应用程序(列表(用户界面 = 用户界面，服务器 = 服务器))更新@SL:我试图在嵌入式按钮的 DT::JS() 部分中移动用于提交和撤消的 javascript 函数，但我无法让它工作.我想我很接近，但不知道问题出在哪里.
表格输出代码将遵循以下结构:
output[["mytable"]] <- renderDT({数据表(数据，逃逸 = -2,extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),回调 = JS(回调)，选项 = 列表(dom = 'frtipB',initComplete = JS(initComplete),rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),columnDefs = 列表(列表(可见 = FALSE，目标 = ncol(dat))，list(className = "dt-center", 目标 = "_all")),按钮 = 列表('复制'，'csv'，列表(扩展=集合"，text = '取消选择',action = DT::JS("function (e, dt, node, config ) {Shiny.setInputValue('SubmitRemoval', true, {priority: 'event'});}")## 将提交 javascript 移到这里),列表(扩展=集合"，text = '恢复',action = DT::JS("function (e, dt, node, config ) {Shiny.setInputValue('UndoRemoval', true, {priority: 'event'});## 将撤销删除 javascript 移到这里}")))))}) 解决方案
这里有一个更好的解决方案(我花了几个小时).这个点击按钮不会重绘表格，按列排序也不会出错.
图书馆(闪亮)图书馆(DT)initComplete <- c(功能(设置){"，" var table=settings.oInstance.api();"," $('#SubmitRemoval').on('click', function(){"," table.$('tr.selected').addClass('x');"," });"," $('#UndoRemoval').on('click', function(){"," table.$('tr').removeClass('x');"," });",}")回调 <- "var xrows = [];table.on('preDraw', function(e, settings) {var tbl = settings.oInstance.api();var nrows = tbl.rows().count();var 行 = tbl.$('tr');var some = false;无功 r = 0;while(!some && r<nrows){if($(rows[r]).hasClass('x')){一些 = 真}r++;}如果(一些){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% selectRows(NULL)})}闪亮应用程序(用户界面，服务器) 更新
这是包含图标的版本:
图书馆(闪亮)图书馆(DT)initComplete <- c(功能(设置){"，" 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);});"," });"," $('#UndoRemoval').on('click', function(){"," table.$('tr').removeClass('x');"," table.$('tr')"," .each(function(i){$(this).find('td').eq(1).html(checkmark);});"," });",}")回调 <- "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 行 = tbl.$('tr');var some = false;无功 r = 0;while(!some && r<nrows){if($(rows[r]).hasClass('x')){一些 = 真}r++;}如果(一些){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% selectRows(NULL)})}闪亮应用程序(用户界面，服务器) 更新
获取input$excludedRows中排除行的索引:
initComplete <- c(功能(设置){"，" 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 excludeRows = [];"," table.$('tr').each(function(i, row){"," if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}"," });"," Shiny.setInputValue('excludedRows', excludeRows);"," });"," $('#UndoRemoval').on('click', function(){"," table.$('tr').removeClass('x');"," table.$('tr')"," .each(function(i){$(this).find('td').eq(1).html(checkmark);});"," Shiny.setInputValue('excludedRows', null);"," });",}")更新
使用 renderDT 的选项 server = FALSE 更容易:
图书馆(闪亮)图书馆(DT)initComplete <- c(功能(设置){"，" var table = settings.oInstance.api();"," $('#SubmitRemoval').on('click', function(){"," table.$('tr.selected').addClass('x').each(function(){"," var td = $(this).find('td').eq(1)[0];"," var cell = table.cell(td);"," cell.data('remove');"," });"," table.draw(false);"," table.rows().deselect();"," var excludeRows = [];"," table.$('tr').each(function(i, row){"," if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}"," });"," Shiny.setInputValue('excludedRows', excludeRows);"," });"," $('#UndoRemoval').on('click', function(){"," 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);"," });",}")渲染 <- c('功能(数据，类型，行，元){'，' if(type === "display"){',' return "<span style=\"color:red;font-size:18px\"><i class=\"glyphicon glyphicon-" + data + "\"></i></span>";',' } 别的 {'，'返回数据;','}','}')ui <-流体页面(标签$头(标签$样式(HTML(.x { 颜色:rgb(211,211,211)；字体样式:斜体；}"))),verbatimTextOutput("excludedRows"),actionButton('SubmitRemoval', '排除选中的行'),actionButton('UndoRemoval', '包括完整数据'),br(),DTOutput('mytable'))服务器 <- 功能(输入，输出，会话){dat <- cbind(Selected = "ok", mtcars[1:6,], id = 1:6)output[["mytable"]] <- renderDT({数据表(数据，扩展名 = "选择",选项 = 列表(initComplete = JS(initComplete),rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))),columnDefs = 列表(列表(可见 = FALSE，目标 = ncol(dat))，list(className = "dt-center", 目标 = "_all"),列表(目标 = 1,渲染 = JS(渲染)))))}, 服务器 = FALSE)代理 <- dataTableProxy("mytable")观察事件(输入[[UndoRemoval"]]，{代理 %>% selectRows(NULL)})output$excludedRows <- renderPrint({输入[[excludedRows"]]})}闪亮应用程序(用户界面，服务器)A bit similar to this question: How to give color to a given interval of rows of a DT table?
but in my case I would like to let the user select rows in the table, then on click of a button deselect the rows, and turn the previously selected rows that are now part of the list of rows submitted for removal grayed out font (color: light gray) and in italic. This to indicate that these will be excluded from further analysis. Secondly a button to undo the entire selection should change all rows back to normal format
I've gotten as far as recording the selected rows and adding the deselect feature, but to then restyle the rows before resetting them escapes me....
Output that I hope to achieve:
Not sure whether it is the right approach, but my thought was to use both
values$selected_rows and values$removed_rows, where the first holds the selection until it is submitted, and removed holds the potentially growing list of rows selected for removal if the user decides to remove more rows on another submit
removed_rows is then also the list of rows that need to be styled (grayed out in italic)
library(shiny)
library(DT)
ui <- fluidPage(
actionButton('SubmitRemoval', 'Exclude selected rows'),
actionButton('UndoRemoval', 'Include full data'),
verbatimTextOutput('Printresult'),
DT::dataTableOutput('mytable')
)
server <- function(input, output,session) {
values <- reactiveValues()
observe({
values$selected_rows <- input$mytable_rows_selected
})
observeEvent(input$SubmitRemoval, {
values$removed_rows <- c(values$removed_rows,input$mytable_rows_selected)
dataTableProxy('mytable') %>% selectRows(NULL)
values$selected_rows <- NULL
removeTab("tabs", "mytable")
})
Remaining_mtcars <- reactive({
req( values$removed_rows)
mtcarsR <- mtcars[-c(values$removed_rows), ]
mtcarsR
})
output$Printresult <- renderText({ nrow(Remaining_mtcars()) })
observeEvent(input$UndoRemoval, {
values$removed_rows <- NULL
})
output$mytable <- DT::renderDataTable({
DT::datatable(mtcars,
extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
options = list(pageLength = 25,
selection = c('multiple'),
dom = 'frtipB'
)
)
})
}
runApp(list(ui = ui, server = server))
UPDATE @SL: I tried to move your javascript functions for submit and undo inside the DT::JS() part of embedded buttons, but I could not get it to work. I guess i'm close, but no idea where the problem is.
The table output code would follow this structure:
output[["mytable"]] <- renderDT({
datatable(dat,
escape = -2,
extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
callback = JS(callback),
options = list(
dom = 'frtipB',
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")
),
buttons = list('copy', 'csv',
list(
extend = "collection",
text = 'Deselect',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('SubmitRemoval', true, {priority: 'event'});
}")
## move the submit javascript here
),
list(
extend = "collection",
text = 'Restore',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('UndoRemoval', true, {priority: 'event'});
## move the undo removal javascript here
}")
)
)
)
)
})
解决方案
Here is a better solution (it took me several hours). This one does not redraw the table when one clicks the button, and it doesn't go wrong when one sorts the table by a column.
library(shiny)
library(DT)
initComplete <- c(
"function(settings) {",
" var table=settings.oInstance.api();",
" $('#SubmitRemoval').on('click', function(){",
" table.$('tr.selected').addClass('x');",
" });",
" $('#UndoRemoval').on('click', function(){",
" table.$('tr').removeClass('x');",
" });",
"}"
)
callback <- "
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');
}
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(mtcars[1:6,], id=1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
callback = JS(callback),
options = list(
initComplete = JS(initComplete),
rowId = JS(sprintf("function(a){return a[%d];}", ncol(dat))),
columnDefs = list(list(visible=FALSE, targets=ncol(dat)))
)
)
})
proxy <- dataTableProxy("mytable")
observeEvent(input[["UndoRemoval"]], {
proxy %>% selectRows(NULL)
})
}
shinyApp(ui, server)
Update
Here is the version including icons:
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);});",
" });",
" $('#UndoRemoval').on('click', function(){",
" table.$('tr').removeClass('x');",
" table.$('tr')",
" .each(function(i){$(this).find('td').eq(1).html(checkmark);});",
" });",
"}"
)
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),
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")
)
)
)
})
proxy <- dataTableProxy("mytable")
observeEvent(input[["UndoRemoval"]], {
proxy %>% selectRows(NULL)
})
}
shinyApp(ui, server)
Update
To get the indices of the excluded rows in input$excludedRows:
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);",
" });",
"}"
)
Update
This is easier with the option server = FALSE of renderDT:
library(shiny)
library(DT)
initComplete <- c(
"function(settings) {",
" var table = settings.oInstance.api();",
" $('#SubmitRemoval').on('click', function(){",
" table.$('tr.selected').addClass('x').each(function(){",
" var td = $(this).find('td').eq(1)[0];",
" var cell = table.cell(td);",
" cell.data('remove');",
" });",
" table.draw(false);",
" 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);",
" });",
" $('#UndoRemoval').on('click', function(){",
" 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; }"
))
),
verbatimTextOutput("excludedRows"),
actionButton('SubmitRemoval', 'Exclude selected rows'),
actionButton('UndoRemoval', 'Include full data'),
br(),
DTOutput('mytable')
)
server <- function(input, output,session) {
dat <- cbind(Selected = "ok", mtcars[1:6,], id = 1:6)
output[["mytable"]] <- renderDT({
datatable(dat,
extensions = "Select",
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"),
list(
targets = 1,
render = JS(render)
)
)
)
)
}, server = FALSE)
proxy <- dataTableProxy("mytable")
observeEvent(input[["UndoRemoval"]], {
proxy %>% selectRows(NULL)
})
output$excludedRows <- renderPrint({
input[["excludedRows"]]
})
}
shinyApp(ui, server)
这篇关于在 R DT(数据表)中以斜体和红色字体格式化行向量的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
