如果数据表列选择器也处于活动状态，如何 select 行
How to select row if datatable column picker is also active
我有一个数据table。我希望用户能够从 table 中选择列（用于各种功能）。我还希望用户能够选中一些框。但是，当用户在我的应用程序中选中一个框时，该列也被选中。我不希望这发生。我怎样才能阻止这个
ui.R
ui<-fluidPage(
# box(width=12,
h3(strong("My picker"),align="center"),
hr(),
# column(6,offset = 6,
HTML('<div class="btn-group" role="group" aria-label="Basic example">'),
actionButton(inputId = "Del_row_head",label = "Delete selected rows"),
HTML('</div>'),
# ),
#column(12,dataTableOutput("Main_table")),
tags$script(HTML('$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {
if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}
}
Shiny.onInputChange("checked_rows",checkboxesChecked);
})')),
tags$script("$(document).on('click', '#Main_table button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random())
});"),
dashboardPage(
dashboardHeader(title = 'My shiny'),
dashboardSidebar(),
dashboardBody( DT::dataTableOutput("endotable")))
)
RV <- reactiveValues(mtcars)
server.R
server <- function(input, output) {
output$endotable = DT::renderDT({
if (!is.null(mtcars)) {
mtcars[["Select"]]<-paste0('<input type="checkbox" name="row_selected" value="Row',1:nrow(mtcars),'"><br>')
mtcars[["Actions"]]<-
paste0('
<div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary delete" id=delete_',1:nrow(mtcars),'>Delete</button>
</div>
')
}
datatable(mtcars,escape=F,options = list(scrollX = TRUE,pageLength = 5),selection = list(target = 'column'))
},selection = list(target = 'column'),escape=F,options = list(scrollX = TRUE,pageLength = 5))
observeEvent(input$Del_row_head,{
row_to_del=as.numeric(gsub("Row","",input$checked_rows))
mtcars=mtcars[-row_to_del]}
)
observeEvent(input$lastClick,
{
if (input$lastClickId%like%"delete")
{
row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
RV$data=RV$data[-row_to_del]
}
else if (input$lastClickId%like%"modify")
{
showModal(modal_modify)
}
}
)
}
shinyApp(ui = ui, server = server)
将selection设置为"none"；我们将 "manually" 在 Select 扩展和回调的帮助下定义选择行为。启用此扩展，使用选项 select = "api"，并将 class notselectable 属性添加到第 12 和 13 列（'Select' 和 'Actions'）：
datatable(mtcars, escape=FALSE, callback = JS(callback),
extensions = "Select", selection = "none",
options = list(
scrollX = TRUE,
pageLength = 5,
columnDefs = list(
list(className = "notselectable", targets = c(12,13))
),
select = "api"))
现在回调：
callback <- c(
"table.on('click', 'tbody td', function(){",
" // if the column is already selected, deselect it:",
" if(table.column(this, {selected: true}).length){",
" table.column(this).deselect();",
" // otherwise, select the column unless there's the class 'notselectable':",
" } else if(!$(this).hasClass('notselectable')){",
" table.column(this).select();",
" }",
"});"
)
编辑
评论中提出的新问题：
The table in the real app is reactive and new columns can be added so
that the targets = c(12,13) will stop the table being shown. How can I
define the last two columns as being not selectable rather than a
specific column number?
使用这个回调：
callback <- c(
"var ncols = table.columns().count();",
"table.on('click', 'tbody td', function(){",
" // if the column is selected, deselect it:",
" if(table.column(this, {selected: true}).length){",
" table.column(this).deselect();",
" // otherwise, select the column unless it's among the last two columns:",
" } else if([ncols-1, ncols-2].indexOf(table.column(this).index()) === -1){",
" table.column(this).select();",
" }",
"});"
)
并且无需将 class 设置为最后两列：
datatable(mtcars, escape=FALSE, callback = JS(callback),
extensions = "Select", selection = "none",
options = list(
scrollX = TRUE,
pageLength = 5,
select = "api"))
编辑 2
获取 Shiny 中所选列的索引：
callback <- c(
"var ncols = table.columns().count();",
"var tbl = table.table().node();",
"var tblID = $(tbl).closest('.datatables').attr('id');",
"table.on('click', 'tbody td', function(){",
" // if the column is selected, deselect it:",
" if(table.column(this, {selected: true}).length){",
" table.column(this).deselect();",
" // otherwise, select the column unless it's among the last two columns:",
" } else if([ncols-1, ncols-2].indexOf(table.column(this).index()) === -1){",
" table.column(this).select();",
" }",
" // send selected columns to Shiny",
" var indexes = table.columns({selected:true}).indexes();",
" var indices = Array(indexes.length);",
" for(var i = 0; i < indices.length; ++i){",
" indices[i] = indexes[i];",
" }",
" Shiny.setInputValue(tblID + '_columns_selected', indices);",
"});"
)
如果table中有行名，则选中列的索引在input$endotable_columns_selected中；如果没有行名称，则索引为 input$endotable_columns_selected + 1.
编辑 3
这是删除行的更简洁的方法：
callback <- c(
"var ncols = table.columns().count();",
"var tbl = table.table().node();",
"var tblID = $(tbl).closest('.datatables').attr('id');",
"table.on('click', 'tbody td', function(){",
" // if the column is selected, deselect it:",
" if(table.column(this, {selected: true}).length){",
" table.column(this).deselect();",
" // otherwise, select the column unless it's among the last two columns:",
" } else if([ncols-2, ncols-3].indexOf(table.column(this).index()) === -1){",
" table.column(this).select();",
" }",
" // send selected columns to Shiny",
" var indexes = table.columns({selected:true}).indexes();",
" var indices = Array(indexes.length);",
" for(var i = 0; i < indices.length; ++i){",
" indices[i] = indexes[i];",
" }",
" Shiny.setInputValue(tblID + '_columns_selected', indices);",
"});",
"/* ---------------------------------------------------------- */",
"// Handler to delete rows",
"Shiny.addCustomMessageHandler('deleteHandler', function(rowIDs){",
" for(var i = 0; i < rowIDs.length; ++i){",
" deleteRow(rowIDs[i]);",
" }",
"});"
)
js <- paste0(
c(
"function deleteRow(rowID){",
" var table = $('#endotable').find('table').DataTable();",
" var nrows = table.rows().count();",
" for(var i=0; i < nrows; ++i){",
" if(table.row(i).id() == rowID){",
" table.row(i).remove().draw(false);",
" break;",
" }",
" }",
"}"
),
collapse = "\n"
)
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
h3(strong("My picker"),align="center"),
hr(),
HTML('<div class="btn-group" role="group" aria-label="Basic example">'),
actionButton(inputId = "Del_row_head",label = "Delete selected rows"),
HTML('</div>'),
tags$script(HTML('$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {
if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}
}
Shiny.onInputChange("checked_rows",checkboxesChecked);
})')),
# tags$script("$(document).on('click', '#Main_table button', function () {
# Shiny.onInputChange('lastClickId',this.id);
# Shiny.onInputChange('lastClick', Math.random())
# });"),
dashboardPage(
dashboardHeader(title = 'My shiny'),
dashboardSidebar(),
dashboardBody( DT::dataTableOutput("endotable")))
)
mtcars[["Select"]] <-
paste0('<input type="checkbox" name="row_selected" value="row_',1:nrow(mtcars),'"><br>')
mtcars[["Actions"]] <-
paste0('
<div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary delete" id=delete_',1:nrow(mtcars),'>Delete</button>
</div>
')
mtcars[["ROWID"]] <- paste0("row_", 1:nrow(mtcars))
server <- function(input, output, session) {
RV <- reactiveValues(data = mtcars)
# observe({
# print(input$endotable_columns_selected)
# })
output$endotable = DT::renderDT({
datatable(RV$data, escape=FALSE, callback = JS(callback),
extensions = "Select", selection = "none",
options = list(
scrollX = TRUE,
pageLength = 5,
select = "api",
rowId = JS(sprintf("function(data){return data[%d];}", ncol(RV$data))),
columnDefs = list(
list(visible = FALSE, targets = -1)
)
)
)
}, server = FALSE)
observeEvent(input[["Del_row_head"]], {
session$sendCustomMessage("deleteHandler", as.list(input$checked_rows))
})
# observeEvent(input$Del_row_head,{
# row_to_del <- as.numeric(gsub("Row","",input$checked_rows))
# RV$data <- RV$data[-row_to_del, ]
# })
#
# observeEvent(input$lastClick,
# {
# if (input$lastClickId%like%"delete")
# {
# row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
# RV$data=RV$data[-row_to_del]
# }
# else if (input$lastClickId%like%"modify")
# {
# showModal(modal_modify)
# }
# }
# )
}
shinyApp(ui = ui, server = server)
我有一个数据table。我希望用户能够从 table 中选择列（用于各种功能）。我还希望用户能够选中一些框。但是，当用户在我的应用程序中选中一个框时，该列也被选中。我不希望这发生。我怎样才能阻止这个
ui.R
ui<-fluidPage(
# box(width=12,
h3(strong("My picker"),align="center"),
hr(),
# column(6,offset = 6,
HTML('<div class="btn-group" role="group" aria-label="Basic example">'),
actionButton(inputId = "Del_row_head",label = "Delete selected rows"),
HTML('</div>'),
# ),
#column(12,dataTableOutput("Main_table")),
tags$script(HTML('$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {
if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}
}
Shiny.onInputChange("checked_rows",checkboxesChecked);
})')),
tags$script("$(document).on('click', '#Main_table button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random())
});"),
dashboardPage(
dashboardHeader(title = 'My shiny'),
dashboardSidebar(),
dashboardBody( DT::dataTableOutput("endotable")))
)
RV <- reactiveValues(mtcars)
server.R
server <- function(input, output) {
output$endotable = DT::renderDT({
if (!is.null(mtcars)) {
mtcars[["Select"]]<-paste0('<input type="checkbox" name="row_selected" value="Row',1:nrow(mtcars),'"><br>')
mtcars[["Actions"]]<-
paste0('
<div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary delete" id=delete_',1:nrow(mtcars),'>Delete</button>
</div>
')
}
datatable(mtcars,escape=F,options = list(scrollX = TRUE,pageLength = 5),selection = list(target = 'column'))
},selection = list(target = 'column'),escape=F,options = list(scrollX = TRUE,pageLength = 5))
observeEvent(input$Del_row_head,{
row_to_del=as.numeric(gsub("Row","",input$checked_rows))
mtcars=mtcars[-row_to_del]}
)
observeEvent(input$lastClick,
{
if (input$lastClickId%like%"delete")
{
row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
RV$data=RV$data[-row_to_del]
}
else if (input$lastClickId%like%"modify")
{
showModal(modal_modify)
}
}
)
}
shinyApp(ui = ui, server = server)
将selection设置为"none"；我们将 "manually" 在 Select 扩展和回调的帮助下定义选择行为。启用此扩展，使用选项 select = "api"，并将 class notselectable 属性添加到第 12 和 13 列（'Select' 和 'Actions'）：
datatable(mtcars, escape=FALSE, callback = JS(callback),
extensions = "Select", selection = "none",
options = list(
scrollX = TRUE,
pageLength = 5,
columnDefs = list(
list(className = "notselectable", targets = c(12,13))
),
select = "api"))
现在回调：
callback <- c(
"table.on('click', 'tbody td', function(){",
" // if the column is already selected, deselect it:",
" if(table.column(this, {selected: true}).length){",
" table.column(this).deselect();",
" // otherwise, select the column unless there's the class 'notselectable':",
" } else if(!$(this).hasClass('notselectable')){",
" table.column(this).select();",
" }",
"});"
)
编辑
评论中提出的新问题：
The table in the real app is reactive and new columns can be added so that the targets = c(12,13) will stop the table being shown. How can I define the last two columns as being not selectable rather than a specific column number?
使用这个回调：
callback <- c(
"var ncols = table.columns().count();",
"table.on('click', 'tbody td', function(){",
" // if the column is selected, deselect it:",
" if(table.column(this, {selected: true}).length){",
" table.column(this).deselect();",
" // otherwise, select the column unless it's among the last two columns:",
" } else if([ncols-1, ncols-2].indexOf(table.column(this).index()) === -1){",
" table.column(this).select();",
" }",
"});"
)
并且无需将 class 设置为最后两列：
datatable(mtcars, escape=FALSE, callback = JS(callback),
extensions = "Select", selection = "none",
options = list(
scrollX = TRUE,
pageLength = 5,
select = "api"))
编辑 2
获取 Shiny 中所选列的索引：
callback <- c(
"var ncols = table.columns().count();",
"var tbl = table.table().node();",
"var tblID = $(tbl).closest('.datatables').attr('id');",
"table.on('click', 'tbody td', function(){",
" // if the column is selected, deselect it:",
" if(table.column(this, {selected: true}).length){",
" table.column(this).deselect();",
" // otherwise, select the column unless it's among the last two columns:",
" } else if([ncols-1, ncols-2].indexOf(table.column(this).index()) === -1){",
" table.column(this).select();",
" }",
" // send selected columns to Shiny",
" var indexes = table.columns({selected:true}).indexes();",
" var indices = Array(indexes.length);",
" for(var i = 0; i < indices.length; ++i){",
" indices[i] = indexes[i];",
" }",
" Shiny.setInputValue(tblID + '_columns_selected', indices);",
"});"
)
如果table中有行名，则选中列的索引在input$endotable_columns_selected中；如果没有行名称，则索引为 input$endotable_columns_selected + 1.
编辑 3
这是删除行的更简洁的方法：
callback <- c(
"var ncols = table.columns().count();",
"var tbl = table.table().node();",
"var tblID = $(tbl).closest('.datatables').attr('id');",
"table.on('click', 'tbody td', function(){",
" // if the column is selected, deselect it:",
" if(table.column(this, {selected: true}).length){",
" table.column(this).deselect();",
" // otherwise, select the column unless it's among the last two columns:",
" } else if([ncols-2, ncols-3].indexOf(table.column(this).index()) === -1){",
" table.column(this).select();",
" }",
" // send selected columns to Shiny",
" var indexes = table.columns({selected:true}).indexes();",
" var indices = Array(indexes.length);",
" for(var i = 0; i < indices.length; ++i){",
" indices[i] = indexes[i];",
" }",
" Shiny.setInputValue(tblID + '_columns_selected', indices);",
"});",
"/* ---------------------------------------------------------- */",
"// Handler to delete rows",
"Shiny.addCustomMessageHandler('deleteHandler', function(rowIDs){",
" for(var i = 0; i < rowIDs.length; ++i){",
" deleteRow(rowIDs[i]);",
" }",
"});"
)
js <- paste0(
c(
"function deleteRow(rowID){",
" var table = $('#endotable').find('table').DataTable();",
" var nrows = table.rows().count();",
" for(var i=0; i < nrows; ++i){",
" if(table.row(i).id() == rowID){",
" table.row(i).remove().draw(false);",
" break;",
" }",
" }",
"}"
),
collapse = "\n"
)
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
h3(strong("My picker"),align="center"),
hr(),
HTML('<div class="btn-group" role="group" aria-label="Basic example">'),
actionButton(inputId = "Del_row_head",label = "Delete selected rows"),
HTML('</div>'),
tags$script(HTML('$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {
if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}
}
Shiny.onInputChange("checked_rows",checkboxesChecked);
})')),
# tags$script("$(document).on('click', '#Main_table button', function () {
# Shiny.onInputChange('lastClickId',this.id);
# Shiny.onInputChange('lastClick', Math.random())
# });"),
dashboardPage(
dashboardHeader(title = 'My shiny'),
dashboardSidebar(),
dashboardBody( DT::dataTableOutput("endotable")))
)
mtcars[["Select"]] <-
paste0('<input type="checkbox" name="row_selected" value="row_',1:nrow(mtcars),'"><br>')
mtcars[["Actions"]] <-
paste0('
<div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary delete" id=delete_',1:nrow(mtcars),'>Delete</button>
</div>
')
mtcars[["ROWID"]] <- paste0("row_", 1:nrow(mtcars))
server <- function(input, output, session) {
RV <- reactiveValues(data = mtcars)
# observe({
# print(input$endotable_columns_selected)
# })
output$endotable = DT::renderDT({
datatable(RV$data, escape=FALSE, callback = JS(callback),
extensions = "Select", selection = "none",
options = list(
scrollX = TRUE,
pageLength = 5,
select = "api",
rowId = JS(sprintf("function(data){return data[%d];}", ncol(RV$data))),
columnDefs = list(
list(visible = FALSE, targets = -1)
)
)
)
}, server = FALSE)
observeEvent(input[["Del_row_head"]], {
session$sendCustomMessage("deleteHandler", as.list(input$checked_rows))
})
# observeEvent(input$Del_row_head,{
# row_to_del <- as.numeric(gsub("Row","",input$checked_rows))
# RV$data <- RV$data[-row_to_del, ]
# })
#
# observeEvent(input$lastClick,
# {
# if (input$lastClickId%like%"delete")
# {
# row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
# RV$data=RV$data[-row_to_del]
# }
# else if (input$lastClickId%like%"modify")
# {
# showModal(modal_modify)
# }
# }
# )
}
shinyApp(ui = ui, server = server)