r - R 组 Shiny 单选按钮？

Question

以下是 Shiny 中的基本 9 个单选按钮问题:

是否可以将这 9 个选项格式化为两个带标签的组，第二组占据两列？

library(shiny)

ui <- bootstrapPage(
  theme = bs_theme(version = 5, 
                   # bootswatch = "flatly",
                   "font-scale" = 1.0), 
  
  div(class = "container-fluid",
      
      div(class = "row",
          div(class="col-12", 
              prettyRadioButtons(
                inputId = "travel_region",
                label = "Group 1",
                selected = NULL,
                status = "primary",
                shape = c("round"),
                width = NULL,
                choices = LETTERS[1:9]
              )
          )
      )
  )
)

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

shinyApp(ui, server)

R 脚本，其中“以上都没有”破坏了 2 列格式(请参阅评论)

library(shiny)
library(bslib)
library(shinyWidgets)
library(htmltools)

prettyRadioButtons9 <- function (
  inputId, label, choices = NULL, selected = NULL, status = "primary", 
  shape = c("round", "square", "curve"), outline = FALSE, 
  fill = FALSE, thick = FALSE, animation = NULL, icon = NULL, 
  plain = FALSE, bigger = FALSE, inline = FALSE, width = NULL, 
  choiceNames = NULL, choiceValues = NULL) 
{
  status <- match.arg(status, c("default", "primary", "success", 
                                "info", "danger", "warning"))
  shape <- match.arg(shape)
  if (is.null(choices) && is.null(choiceNames) && is.null(choiceValues)) {
    choices <- character(0)
  }
  args <- shinyWidgets:::normalizeChoicesArgs(choices, choiceNames, choiceValues)
  selected <- shiny::restoreInput(id = inputId, default = selected)
  selected <- if (is.null(selected)) {
    args$choiceValues[[1]]
  }
  else {
    as.character(selected)
  }
  if (length(selected) > 1) 
    stop("The 'selected' argument must be of length 1")
  options1 <- shinyWidgets:::generatePretty(
    inputId = inputId, selected = selected, 
    inline = inline, type = "radio", choiceNames = args$choiceNames[1:3], 
    choiceValues = args$choiceValues[1:3], status = status, shape = shape, 
    outline = outline, fill = fill, thick = thick, animation = animation, 
    icon = icon, plain = plain, bigger = bigger
  )
  options2 <- shinyWidgets:::generatePretty(
    inputId = inputId, selected = selected, 
    inline = inline, type = "radio", 
    choiceNames = c("Amsterdam", "Frankfurt", "London"),
    choiceValues = c("amsterdam", "frankfurt", "london"),
    status = status, shape = shape, 
    outline = outline, fill = fill, thick = thick, animation = animation, 
    icon = icon, plain = plain, bigger = bigger
  )
  options3 <- shinyWidgets:::generatePretty(
    inputId = inputId, selected = selected, 
    inline = inline, type = "radio", 
    choiceNames = c("Amsterdam", "Frankfurt", "None of the above"),
    choiceValues = c("amsterdam", "frankfurt", "london"),
    status = status, shape = shape, 
    outline = outline, fill = fill, thick = thick, animation = animation, 
    icon = icon, plain = plain, bigger = bigger
  )
  options <- tags$div(
    tags$div(
      tags$fieldset(
        tags$legend("Group 1"),
        options1
      )
    ),
    tags$div(
      tags$fieldset(
        tags$legend("Group 2"),
        tags$div(
          style = "display: inline-block;",
          options2
        ),
        tags$div(
          style = "display: inline-block;",
          options3
        )
      )
    )
  )
  divClass <- "form-group shiny-input-radiogroup shiny-input-container"
  if (inline) 
    divClass <- paste(divClass, "shiny-input-container-inline")
  radioTag <- htmltools::tags$div(id = inputId, style = if (!is.null(width)) 
    paste0("width: ", validateCssUnit(width), ";"), class = divClass, 
    tags$label(class = "control-label", `for` = inputId, 
               class = if (is.null(label)) 
                 "shiny-label-null", label), options)
  shinyWidgets:::attachShinyWidgetsDep(radioTag, "pretty")
}

ui <- bootstrapPage(
  theme = bs_theme(version = 5, 
                   # bootswatch = "flatly",
                   "font-scale" = 1.0), 
  
  div(class = "container-fluid",
      
      div(class = "row",
          div(class = "col-12", 
              prettyRadioButtons9(
                inputId = "travel_region",
                label = NULL,
                selected = NULL,
                status = "primary",
                shape = c("round"),
                width = NULL,
                choices = LETTERS[1:9]
              )
          )
      )
  )
)

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

shinyApp(ui, server)

Answer 1

我对prettyRadioButtons函数进行了修改。但这仅针对您的情况 (3/3-3)。

library(shiny)
library(bslib)
library(shinyWidgets)
library(htmltools)

prettyRadioButtons9 <- function (
  inputId, label, choices = NULL, selected = NULL, status = "primary", 
  shape = c("round", "square", "curve"), outline = FALSE, 
  fill = FALSE, thick = FALSE, animation = NULL, icon = NULL, 
  plain = FALSE, bigger = FALSE, inline = FALSE, width = NULL, 
  choiceNames = NULL, choiceValues = NULL) 
{
  status <- match.arg(status, c("default", "primary", "success", 
                                "info", "danger", "warning"))
  shape <- match.arg(shape)
  if (is.null(choices) && is.null(choiceNames) && is.null(choiceValues)) {
    choices <- character(0)
  }
  args <- shinyWidgets:::normalizeChoicesArgs(choices, choiceNames, choiceValues)
  selected <- shiny::restoreInput(id = inputId, default = selected)
  selected <- if (is.null(selected)) {
    args$choiceValues[[1]]
  }
  else {
    as.character(selected)
  }
  if (length(selected) > 1) 
    stop("The 'selected' argument must be of length 1")
  options1 <- shinyWidgets:::generatePretty(
    inputId = inputId, selected = selected, 
    inline = inline, type = "radio", choiceNames = args$choiceNames[1:3], 
    choiceValues = args$choiceValues[1:3], status = status, shape = shape, 
    outline = outline, fill = fill, thick = thick, animation = animation, 
    icon = icon, plain = plain, bigger = bigger
  )
  options2 <- shinyWidgets:::generatePretty(
    inputId = inputId, selected = selected, 
    inline = inline, type = "radio", choiceNames = args$choiceNames[4:6], 
    choiceValues = args$choiceValues[4:6], status = status, shape = shape, 
    outline = outline, fill = fill, thick = thick, animation = animation, 
    icon = icon, plain = plain, bigger = bigger
  )
  options3 <- shinyWidgets:::generatePretty(
    inputId = inputId, selected = selected, 
    inline = inline, type = "radio", choiceNames = args$choiceNames[7:9], 
    choiceValues = args$choiceValues[7:9], status = status, shape = shape, 
    outline = outline, fill = fill, thick = thick, animation = animation, 
    icon = icon, plain = plain, bigger = bigger
  )
  options <- tags$div(
    tags$div(
      tags$fieldset(
        tags$legend("Group 1"),
        options1
      )
    ),
    tags$div(
      tags$fieldset(
        tags$legend("Group 2"),
        tags$div(
          style = "display: inline-block;",
          options2
        ),
        tags$div(
          style = "display: inline-block;",
          options3
        )
      )
    )
  )
  divClass <- "form-group shiny-input-radiogroup shiny-input-container"
  if (inline) 
    divClass <- paste(divClass, "shiny-input-container-inline")
  radioTag <- htmltools::tags$div(id = inputId, style = if (!is.null(width)) 
    paste0("width: ", validateCssUnit(width), ";"), class = divClass, 
    tags$label(class = "control-label", `for` = inputId, 
               class = if (is.null(label)) 
                 "shiny-label-null", label), options)
  shinyWidgets:::attachShinyWidgetsDep(radioTag, "pretty")
}

ui <- bootstrapPage(
  theme = bs_theme(version = 5, 
                   # bootswatch = "flatly",
                   "font-scale" = 1.0), 
  
  div(class = "container-fluid",
      
      div(class = "row",
          div(class = "col-12", 
              prettyRadioButtons9(
                inputId = "travel_region",
                label = NULL,
                selected = NULL,
                status = "primary",
                shape = c("round"),
                width = NULL,
                choices = LETTERS[1:9]
              )
          )
      )
  )
)

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

shinyApp(ui, server)

---

编辑

如果这不起作用，您可以尝试使用弹性盒:

  options <- tags$div(
    tags$div(
      tags$fieldset(
        tags$legend("Group 1"),
        options1
      )
    ),
    tags$div(
      tags$fieldset(
        tags$legend("Group 2"),
        tags$div(
          style = "display: flex;",
          tags$div(
            options2
          ),
          tags$div(
            options3
          )
        )
      )
    )
  )