使用 data.table 进行闪亮的输入并将用户输入存储在 data.frame 中

Question

在我的闪亮应用程序中，我希望使用 data.table 通过单选按钮或复选框获取用户输入，并将用户输入存储在 data.frame 中。

这是我目前所取得的成就：

library(shiny)
library(data.table)
library(DT)
shinyApp(
  ui = fluidPage(
    title = 'Radio buttons in a table',
    DT::dataTableOutput('foo'),
    verbatimTextOutput('sel')
  ),
  server = function(input, output, session) {

    x <- data.table( 'Breed Split' = paste0("F",rep(0:16)), Frisian = rep(1,17), Jersey = rep(2,17), Cross = rep(3,17) )

    x[, Frisian := sprintf( '<input type="radio" name="%s" value="%s"/>', `Breed Split`, x[, Frisian] )]
    x[, Jersey := sprintf( '<input type="radio" name="%s" value="%s"/>', `Breed Split`, x[, Jersey] )]
    x[, Cross := sprintf( '<input type="radio" name="%s" value="%s"/>', `Breed Split`, x[, Cross] )]

    output$foo = DT::renderDataTable(
      x, escape = FALSE, selection = 'none', server = FALSE, rownames=FALSE,
      options = list(dom = 't', paging = FALSE, ordering = FALSE),
      callback = JS("table.rows().every(function(i, tab, row) {
                    var $this = $(this.node());
                    $this.attr('id', this.data()[0]);
                    $this.addClass('shiny-input-radiogroup');
  });
                    Shiny.unbindAll(table.table().node());
                    Shiny.bindAll(table.table().node());")
    )
    output$sel = renderPrint({
      str(sapply(x$`Breed Split`, function(i) input[[i]]))
    })
  }

)

另一件事是如果有任何方法可以设置默认输入值，如此屏幕截图所示。

[]

Answer 1

尝试添加检查名称的列，然后在呈现 DT 时删除列

   library(shiny)
library(data.table)
library(DT)
shinyApp(
  ui = fluidPage(
    title = 'Radio buttons in a table',
    DT::dataTableOutput('foo'),
    verbatimTextOutput('sel')
  ),
  server = function(input, output, session) {

    x <- data.table( 'Breed Split' = paste0("F",rep(0:16)), Frisian = rep(1,17), Jersey = rep(2,17), Cross = rep(3,17) ,
                     checked=c(rep("Frisian",9),rep("Jersey",5),rep("Cross",3))
                     )

    x[, Frisian := sprintf( '<input type="radio" name="%s" value="%s" %s/>', `Breed Split`, x[, Frisian],ifelse("Frisian"==x[, checked],"checked" ,""))]
    x[, Jersey := sprintf( '<input type="radio" name="%s" value="%s" %s/>', `Breed Split`, x[, Jersey],ifelse("Jersey"==x[, checked],"checked" ,"" ))]
    x[, Cross := sprintf( '<input type="radio" name="%s" value="%s" %s/>', `Breed Split`, x[, Cross] ,ifelse("Cross"==x[, checked],"checked" ,""))]

    output$foo = DT::renderDataTable(
      x[,-c("checked")], escape = FALSE, selection = 'none', server = FALSE, rownames=FALSE,
      options = list(dom = 't', paging = FALSE, ordering = FALSE),
      callback = JS("table.rows().every(function(i, tab, row) {
                    var $this = $(this.node());
                    $this.attr('id', this.data()[0]);
                    $this.addClass('shiny-input-radiogroup');
  });
                    Shiny.unbindAll(table.table().node());
                    Shiny.bindAll(table.table().node());")
    )
    output$sel = renderPrint({
      str(sapply(x$`Breed Split`, function(i) input[[i]]))
    })
    }

)