R 如果datatable列选择器也处于活动状态，如何选择行

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

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 <- 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)

---

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

现在返回回调：

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


编辑2
要获取选定列的索引，请执行以下操作：

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

好啊谢谢@StephaneLaurent。real app中的表格是被动的，可以添加新的列，以便targets=c（12,13）将停止显示表格。如何将最后两列定义为不可选择，而不是特定的列号？@SebastianZeki
list（className=“notselective”，targets=c（-1，-2））
有效，但我不确定如果添加列，这是否正确。试试看。@SebastianZeki看到我的编辑了。也许这个解决方案更好。我刚刚意识到表现在不允许我使用从其他函数中选择的输入$endotable\u columns\u返回的值。为什么会这样？如何允许？@SebastianZeki啊，是的，我们也必须手动定义。请参阅我的第二次编辑。
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"))

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

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)