Shiny - shiny中表格中的复选框

Question

我已经在 link 的shiny中读取并实现了表中的复选框。但是当我在R中运行时，列中的输出在每个"pick“单元格中都是<input type="checkbox" name="row1" value="1"> , <input type="checkbox" name="row2" value="2">，依此类推，我希望"pick”列中的输出是checkbox，那么我的问题的解决方案是什么？谢谢，这是代码

library(shiny)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(
  list(ui = pageWithSidebar(
    headerPanel('Examples of DataTables'),
    sidebarPanel(
      checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars),
                         selected = names(mymtcars))
      ,textInput("collection_txt",label="Foo")
    ),
    mainPanel(
      dataTableOutput("mytable")
    )
  )
  , server = function(input, output, session) {
    rowSelect <- reactive({
      paste(sort(unique(input[["rows"]])),sep=',')
    })
    observe({
      updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Foo:" )
    })
    output$mytable = renderDataTable({
      addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '">',"")
      #Display table with checkbox buttons
      cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE])
    }, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25)
    , callback = "function(table) {
    table.on('change.dt', 'tr td input:checkbox', function() {
    setTimeout(function () {
    Shiny.onInputChange('rows', $(this).add('tr td input:checkbox:checked').parent().siblings(':last-child').map(function() {
    return $(this).text();
    }).get())
    }, 10); 
    });
  }")
  }
  )
)

Answer 1

您可以在, escape = FALSE see中使用DT

library(shiny)
library(DT)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(
  list(ui = pageWithSidebar(
    headerPanel('Examples of DataTables'),
    sidebarPanel(
      checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars),
                         selected = names(mymtcars))
      ,textInput("collection_txt",label="Foo")
    ),
    mainPanel(
      DT::dataTableOutput("mytable")
    )
  )
  , server = function(input, output, session) {
    rowSelect <- reactive({
      paste(sort(unique(input[["rows"]])),sep=',')
    })
    observe({
      updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Foo:" )
    })
    output$mytable = DT::renderDataTable({
      addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '">',"")
      #Display table with checkbox buttons
      DT::datatable(cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE]),
                    options = list(orderClasses = TRUE,
lengthMenu = c(5, 25, 50),
pageLength = 25, 
callback = JS("function(table) {
    table.on('change.dt', 'tr td input:checkbox', function() {
          setTimeout(function () {
          Shiny.onInputChange('rows', $(this).add('tr td input:checkbox:checked').parent().siblings(':last-child').map(function() {
          return $(this).text();
          }).get())
          }, 10); 
          });
          }")),escape = FALSE,

                    )
    } 
    )
  }
  )
)

更新

使用shinyinput以其他方式制作

library(shiny)
library(DT)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(
  list(ui = pageWithSidebar(
    headerPanel('Examples of DataTables'),
    sidebarPanel(
      checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars),
                         selected = names(mymtcars))
      ,textInput("collection_txt",label="Foo")
    ),
    mainPanel(
      DT::dataTableOutput("mytable")
    )
  )
  , server = function(input, output, session) {

    shinyInput <- function(FUN,id,num,...) {
      inputs <- character(num)
      for (i in seq_len(num)) {
        inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
      }
      inputs
    }

    rowSelect <- reactive({

      rows=names(input)[grepl(pattern = "srows_",names(input))]
      paste(unlist(lapply(rows,function(i){
        if(input[[i]]==T){
          return(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
        }
      })))

    })

    observe({
      updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Foo:" )
    })
    output$mytable = DT::renderDataTable({
      #Display table with checkbox buttons
    DT::datatable(cbind(Pick=shinyInput(checkboxInput,"srows_",nrow(mymtcars),value=NULL,width=1), mymtcars[, input$show_vars, drop=FALSE]),
                    options = list(orderClasses = TRUE,
                                   lengthMenu = c(5, 25, 50),
                                   pageLength = 25 ,

                                   drawCallback= JS(
                                     'function(settings) {
                                     Shiny.bindAll(this.api().table().node());}')
                                  ),selection='none',escape=F)


      } 
  )


    })
                    )