【问题标题】：How to select row if datatable column picker is also active如果数据表列选择器也处于活动状态，如何选择行
【发布时间】：2019-10-22 03:12:43
【问题描述】：

我有一个数据表。我希望用户能够从表中选择列（用于各种功能）。我还希望用户能够选中一些框。但是，当用户在我的应用程序中选中一个框时，该列也会被选中。我不希望这种情况发生。我怎样才能阻止它

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)

【问题讨论】：

标签： r shiny datatables dt

【解决方案1】：

将selection 设置为"none"；我们将在Select 扩展和回调的帮助下“手动”定义选择行为。启用此扩展，使用选项 select = "api"，并将类 notselectable 分配给第 12 和 13 列（“选择”和“操作”）：

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();",
  "  }",
  "});"
)

编辑

评论中提出的新问题：

真实应用程序中的表格是反应式的，可以添加新列，因此目标 = c(12,13) 将停止显示表格。我怎样才能将最后两列定义为不可选择而不是具体列号？

使用这个回调：

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();",
  "  }",
  "});"
)

并且不需要为最后两列设置一个类：

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);",
  "});"
)

那么选中列的索引在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)

【讨论】：

好的。谢谢@StephaneLaurent。真实应用程序中的表格是反应式的，可以添加新列，以便目标 = c(12,13) 将停止显示表格。如何将最后两列定义为不可选择而不是特定列号？
@SebastianZeki list(className = "notselectable", targets = c(-1,-2)) 有效，但如果您添加列，我不确定这是否可以。试一试。
@SebastianZeki 查看我的编辑。也许这个解决方案更好。
我刚刚意识到该表现在不允许我在其他函数中使用从 input$endotable_columns_selected 返回的值。为什么会这样以及如何允许？
@SebastianZeki 是的，我们也必须手动定义它。请参阅我的第二次编辑。