从循环创建单选按钮并在R Shiny

Question

我正在寻找一种使用动作按钮一次性选择所有单选按钮的方法。在下面的示例中，使用循环创建单选按钮（是，否）。现在，有两个按钮 - “YES SELECT ALL”和“NO SELECT ALL”，现在基于“YES SELECT ALL”按钮单击所有是选项的单选按钮被选中。 “NO SELECT ALL”按钮也是如此。寻找达到同样目的的方法。

library(shiny)

ui <- fluidPage(
title = 'Creating a UI from a loop',

sidebarLayout(
sidebarPanel(

  lapply(1:5, function(i) {
    selectInput(paste0('a', i), paste0('SelectA', i),
                choices = sample(LETTERS, 5))
  })
),

mainPanel(
  verbatimTextOutput('a_out'),

  br(),

  uiOutput("c_ui"),

  br(),

  actionButton("yesall","YES ALL SELECT"),
  actionButton("noall","NO ALL SELECT"),

  br(),


  lapply(1:10, function(i) {
    uiOutput(paste0('b', i))
  })
)
)
)


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

output$a_out <- renderPrint({
res <- lapply(1:5, function(i) input[[paste0('a', i)]])
str(setNames(res, paste0('a', 1:5)))
})

lapply(1:10, function(i) {
output[[paste0('b', i)]] <- renderUI({
  strong(paste0('Hi, this is output B#', i))
})
})

output$c_ui  <- renderUI({

lapply(1:5, function(i) {

  radioButtons(paste0('c', i), label = "",choices = list("Yes" = "yes", "No" = "may be"),selected = character(0),inline = TRUE)

})

})

}

shinyApp(ui,server)

Answer 1

这样的东西？

library(shiny)

ui <- fluidPage(
  title = 'Creating a UI from a loop',

  sidebarLayout(
    sidebarPanel(

      lapply(1:5, function(i) {
        selectInput(paste0('a', i), paste0('SelectA', i),
                    choices = sample(LETTERS, 5))
      })
    ),

    mainPanel(
      verbatimTextOutput('a_out'),

      br(),

      uiOutput("c_ui"),

      br(),

      actionButton("yesall","YES ALL SELECT"),
      actionButton("noall","NO ALL SELECT"),

      br(),


      lapply(1:10, function(i) {
        uiOutput(paste0('b', i))
      })
    )
  )
)


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

  output$a_out <- renderPrint({
    res <- lapply(1:5, function(i) input[[paste0('a', i)]])
    str(setNames(res, paste0('a', 1:5)))
  })

  lapply(1:10, function(i) {
    output[[paste0('b', i)]] <- renderUI({
      strong(paste0('Hi, this is output B#', i))
    })
  })

  output$c_ui  <- renderUI({
    lapply(1:5, function(i) {
      radioButtons(paste0('c', i), label = "",choices = list("Yes" = "yes", "No" = "may be"),selected = character(0),inline = T)
    })
  })


  observeEvent(input$yesall,{
    lapply(1:5, function(i) {
      updateRadioButtons(session,paste0('c', i), label = "",choices = list("Yes" = "yes", "No" = "may be"),selected = "yes",inline = T)
    })
  })

  observeEvent(input$noall,{
    lapply(1:5, function(i) {
      updateRadioButtons(session,paste0('c', i), label = "",choices = list("Yes" = "yes", "No" = "may be"),selected = "may be",inline = T)
    })
  })
}

shinyApp(ui,server)