Display data table with buttons in each row using Shiny for a given data frame to appear as shown table

问题

Here is the data frame

sports=data_frame(question=c("<h5>This gives you more information about pro Football
                             What position would you prefer to play in pro Football?</h5>",
                  "</h5>This gives you more information about pro Soccer
                             What position would you prefer to play in pro Soccer?</h5>",
                  "</h5>This gives you more information about pro Hockey
                             What position would you prefer to play in pro Hockey?</h5>"),
`Expected Money`= c(list(c('First Year = 10', 'First 3 Years= 50')),
                           list(c('First Year = 15', 'First 4 Years= 50')),
                           NA),
`Expected Injury Risk`= c(list(c('Death=0.0001%', 'Severe= 0.001%')),
                                 list(c('Minor=0.01%', 'Severe= 0.0001%')),
                                 list(c('Death=0.00001%', 'Severe= 0.002%'))),
`Field Dimentions`=c( NA,
                             list(c('length=100', 'width=60')),
                             list(c('length=50', 'width=30'))),
position=c(list(c('QB',"DB","RB","LB")),
                  list(c('Forward', 'Defender','Goal keeper')),
                  list(c('Forward', 'Winger','Goal Tender')))
)

I want to make it appear as the following image. I would prefer that the dropdown buttons with choices=NA are not displayed. The bottom buttons in each row are informational only and I am not interested in the response to those. I will be only interested in a the response to the question, i.e., which position was selected for which row. Thanks for trying to help!

The following code fails to arrange the informational buttons as I need them to be. Only the first informational button shows up.

library(shiny)
library(DT)
library(shinyWidgets)


shinyApp(
  ui <- fluidPage(
    DT::dataTableOutput("data"),
    textOutput('myText')
  ),
  
  server <- function(input, output) {
    
    myValue <- reactiveValues(result = '')
    
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- character(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), ...))
      }
      inputs
    }
    L=NULL
 
    df <- reactiveValues(data = data.frame(
      
      Name = paste('<h5>',c('Dilbert is a dragon with high speed in the air', 'Alice', 'Wally', 'Ashok', 'Dogbert'),'</h5>', 
       #cbind instead of paste arranges buttons row-wise
       
       cbind(shinyInput(pickerInput, 5, 'button_', label = "Pets",choices=1:3 ), 
                      shinyInput(pickerInput, len=5, id='Friends',label='Friends', choices=LETTERS[1:3] )
                      )),
      Res= shinyInput(dropdown, 5, id='Enemies', label = "Enemies")
                  ))
    
    
    output$data <- DT::renderDataTable(
      df$data, server = FALSE, escape = FALSE, selection = 'none'
    )
    
    observeEvent(input$select_button, {
      selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
      myValue$result <<- paste('click on ',df$data[selectedRow,1])
    })
    
    
    output$myText <- renderText({
      
      myValue$result
      
    })

  }
)

来源：https://stackoverflow.com/questions/63553143/display-data-table-with-buttons-in-each-row-using-shiny-for-a-given-data-frame-t

标签

dataframe

button

Shiny

dropdown