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

时间:2017-07-11 23:55:21

标签: r data.table shiny dt

在我的shinyapp中,我希望使用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]]))
    })
  }

)

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

[image]

1 个答案:

答案 0 :(得分:4)

尝试添加已检查名称的列,然后删除渲染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]]))
    })
    }

)