r - 在 Shiny 中为表格的每一行选择输入

Question

我有一个包含三列和可变行数的表格。我想创建一个列，使新列的每一行都包含一个值为是/否的 selectInput。

简而言之，我如何自动生成等于表中行数的 selectInput

这是一个简单的代码:

library(shiny)
library(rhandsontable)

ui <- fluidPage(

  tableOutput('Simpletable')

)

server <- function(input,output,session)({

  data <- data.frame(c1=c(5,10,15), c2=c(3,6,9) , diff=c(0,0,0), select= as.logical( c(FALSE,FALSE,FALSE)))


  output$Simpletable <- renderTable(
    data
  )

}) 

shinyApp(ui = ui, server = server) 

对于这个表，三个 selectInputs 应该出现在表的旁边

这可能吗？

谢谢

Answer 1

这是一个使用 library(DT) 的解决方案 - 我们需要设置 escape = FALSE:

library(shiny)
library(DT)
library(data.table)

myTable <- data.table(c1=c(5,10,15), c2=c(3,6,9) , diff=c(0,0,0))
myTable[, row_id := paste0("row_select_", .I)][, select := as.character(selectInput(inputId=row_id, label=NULL, choices=c(yes=TRUE, no=FALSE))), by = row_id]

ui <- fluidPage(
  dataTableOutput('myTableOutput'),
  htmlOutput("mySelection")
)

server <- function(input, output, session){
  output$myTableOutput <- DT::renderDataTable({
    datatable(myTable, escape = FALSE, options = list(
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
    ))
  })
  
  output$mySelection <- renderUI({
    HTML(paste0(myTable$row_id, ": ", lapply(myTable$row_id, function(x){input[[x]]}), collapse = "<br>"))
  })
} 

shinyApp(ui = ui, server = server) 

如果您需要重新渲染表格(使用 Shiny.bindAll 时)，请参阅 related post .

---

编辑:这是按照@Fahadakbar 的要求将用户输入合并到表中的方法。

library(shiny)
library(DT)
library(data.table)

myTable <- data.table(c1=c(5,10,15), c2=c(3,6,9) , diff=c(0,0,0))
myTable[, row_id := paste0("row_select_", .I)][, select := as.character(selectInput(inputId=row_id, label=NULL, choices=c(yes=TRUE, no=FALSE))), by = row_id][, diff := c1-c2]

ui <- fluidPage(
  dataTableOutput('myTableOutput'),
  htmlOutput("mySelection")
)

server <- function(input, output, session){
  output$myTableOutput <- DT::renderDataTable({
    datatable(myTable, escape = FALSE, options = list(
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
    ))
  })
  
  output$mySelection <- renderUI({
    HTML(paste0(myTable$row_id, ": ", lapply(myTable$row_id, function(x){input[[x]]}), collapse = "<br>"))
  })
  
  myReactiveTable <- reactive({
    myTable[, selected := as.logical(unlist(lapply(row_id, function(x){input[[x]]})))]
    
    if(is.null(myTable$selected)){
      myTable[, diff := NA_real_][, selected := NULL]
    } else {
      myTable[, diff := fifelse(selected, yes = c1-c2, no = NA_real_)][, select := as.character(selectInput(inputId=row_id, label=NULL, choices=c(yes=TRUE, no=FALSE), selected = input[[row_id]])), by = row_id][, selected := NULL]
    }
  })
  
  myTableProxy <- dataTableProxy("myTableOutput", session)
  
  observeEvent(myReactiveTable(), {
    replaceData(myTableProxy, data = myReactiveTable(), resetPaging = FALSE)
  })
  
} 

shinyApp(ui = ui, server = server) 

另见我的相关回答here .