在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_rows 也是需要设置样式的行列表（
library（shi ny）
库（DT）
ui<-fluidPage（
actionButton（'SubmitRemoval'，'排除所选行'），
actionButton （'UndoRemoval'，'包括完整数据'），
verbatimTextOutput（'Printresult'），
DT :: dataTableOutput（'mytable'）
）
服务器<-函数（输入，输出，会话）{
值<-reactValues（）
观察（{
values $ selected_rows< ;-input $ mytable_rows_selected
}）
watchEvent（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<-反应性（{
req（values $ removed_rows）
mtcarsR<-mtcars [-c（values $ removed_rows）， ]
mtcarsR
}）
output $ Printresult<-renderText （{nrow（Remaining_mtcars（））}）
watchEvent（input $ UndoRemoval，{
values $ removed_rows<-NULL
}）
output $ mytable<-DT :: renderDataTable（{
DT :: datatable（mtcars，
extensions = c（'Buttons'，'ColReorder'，'FixedHeader'，'Scroller' ），
选项=列表（pageLength = 25，
选择= c（'multiple'），
dom ='frtipB'
）
）
}）
}
runApp（list（ui = ui，server = server））
更新
@SL：我试图将您的JavaScript函数移至嵌入式按钮的DT :: JS（）部分内进行提交和撤消操作，但无法正常工作。我想我接近了，但不知道问题出在哪里。
表输出代码将遵循以下结构：
输出[ [ mytable]]<-renderDT（{
datatable（dat，
escape = -2，
extensions = c（'Buttons'，'ColReorder'，'FixedHeader'，' Scroller'），
回调= JS（回调），
选项=列表（
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，目标= _all）
），
按钮= list（'copy'，'csv'，
list （
扩展=集合，
文本='取消选择'，
动作= DT :: JS（ function（e，dt，node，config）{
Shiny.setInputValue（’SubmitRemoval’，true，{priority：’event’}）；
}）
##将提交的javascript移至此处
），
列表（
扩展=集合，
文本='恢复'，
action = DT :: JS（ function（e，dt，node，config）{
Shiny.setInputValue（'UndoRemoval'，true，{priority：'event'}）;
##将撤消撤消javascript移动到此处
}）
）
）
）
）
}）
解决方案
这是一个更好的解决方案（花了我几个小时），这个没有重绘表格单击一个按钮时，按列对表格进行排序也不会出错。
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'）;，
}）;，
}
）
回调<-
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；字体样式：斜体}
table.dataTable tr.selected.x td {background-color：rgb（211,211,211）！important;}
））
）） ，
actionButton（'SubmitRemoval'，'排除所选行'），
actionButton（'UndoRemoval'，'包括完整数据'），
br（），
DTOutput（' mytable'）
）
服务器<-函数（输入，输出，会话）{
dat<-cbind（mtcars [1 ：6，]，id = 1：6）
output [[ mytable]]<-renderDT（{
datatable（dat，
callback = JS（callback ），
选项=列表（
initComplete = JS（initComplete），
rowId = JS（sprintf（ function（a）{return a [％d];}，ncol（dat ））），
columnDefs = list（list（visible = FALSE，target = ncol（dat）））
）
）
}）
代理人t;-dataTableProxy（ mytable）
watchEvent（input [[ UndoRemoval]]，{
proxy％>％selectRows（NULL）
}）
}
ShinyApp（ui，服务器）
更新
以下是包含图标的版本：
库（发光）
库（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 （选中标记）;}）;，
}）;，
}
）
回调<-
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; 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
行。 addClass（'x'）。find（'td'）。eq（1）.html（cross）;
}
xrows = [];
}）;
ui<-fluidPage（
tags $ head（
tags $ style（HTML（
.x {background-color：rgb（211,211 ，211）！important;字体样式：斜体}
table.dataTable tr.selected.x td {背景颜色：rgb（211,211,211）！important;}
））
），
actionButton （'SubmitRemoval'，'排除选定的行'），
actionButton（'UndoRemoval'，'包括完整数据'），
br（），
DTOutput（'mytable'）
）
服务器<-函数（输入，输出，会话）{
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（回调），
选项=列表（
initComplete = JS（initComplete），
rowId = JS（sprintf（ function（data）{return data [％d];}， ncol（dat））），
columnDefs = list（
list（visible = FALSE，目标= ncol（da t）），
list（className = dt-center，目标= _all）
）
）
）
}）
代理<-dataTableProxy（ mytable）
watchEvent（input [[ UndoRemoval]]，{
代理％>％selectRows（NULL）
}）
}
ShinyApp（ui，服务器）
更新
input $ excludedRows 中排除行的索引：
initComplete< -c（
function（settings）{，
var table = settings.oInstance.api（）;，
var cross ='< span style = \红色; 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）;，
}）;，
}
）
更新
使用选项 server = FALSE <会更容易/ code>的 renderDT ：
库（发光）
库（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 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）;，
}）;，
}
）
render<-c （
'function（data，type，row，meta）{'，
'if（type === display）{'，
'return< span style = ＼ \\\\红色; font-size：18px\\\< i class = \\\ glyphicon glyphicon- +数据+ \\\< / i< / span>;'，'，
'} else {'，
'返回数据;'，
'}'，
'}'
）
ui<-fluidPage（
tags $ head（
tags $ style（HTML（
.x {color：rgb（211,211,211）; font-style：italic; }
））
），
verbatimTextOutput（ excludedRows），
actionButton（'SubmitRemoval'，'排除所选行'），
actionButton（'UndoRemoval '，'包括完整数据'），
br（），
DTOutput（'mytable'）
）
服务器<-函数（输入，输出，会话）{
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（可见= FALSE，目标= ncol（dat）），
list（className = dt-center，目标= _all），
list（
目标= 1，
渲染= JS（渲染）
）
）
）
）
}，服务器= FALSE）
proxy<-dataTableProxy（ mytable）
watchEvent（input [[ UndoRemoval]]，{
proxy％>％selectRows（NULL）
}）
output $ excludedRows<-renderPrint（{
input [[ excludedRows]]
}）
}
ShinyApp（ui，服务器）
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屋！
查看全文
