如何实现shinyWidgets::radioGroupButtons的小屏幕响应式适配？

问题背景 #

你的Shiny应用里，模态框本身支持响应式布局，但shinyWidgets::radioGroupButtons生成的选项组在小屏幕上会溢出模态框边界，无法自动适配窄屏宽度。

原代码 #

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

# Functions-------
radio_inv <- function(id, label, width = "100%", ...) {
  shinyWidgets::radioGroupButtons(
    inputId = id,
    size = "sm",
    label = HTML("<h4>", label, "<span style='color:red'>*</span>", "</h4>"),
    choices = c(
      "Strongly Disagree",
      "Somewhat Disagree",
      "Disagree",
      "Agree",
      "Somewhat Agree",
      "Strongly Agree"
    ),
    selected = character(0),
    checkIcon = list(
      yes = icon("ok",
                 lib = "glyphicon"
      )
    ),
    width = width,
    justified = TRUE,
    ...
  )
}

# App ------------------------
ui <- bslib::page_fluid(
  tagList(
    # Button to start the questionnaire
    actionButton("start_intake",
                 label = "Start")
  ),
  theme = bs_theme(version = 5,
                   preset = "shiny")
)

server <- function(input, output, session) {
  observeEvent(input$start_intake, {
    survey_qs <- div(
      radio_inv("inv1", "I like sushi."),
      br(),
      br(),
      radio_inv("inv2", "I hate cake.")
    )
    page1 <- modalDialog(
      title = "Survey",
      survey_qs,
      footer = tagList(
        actionButton("submit",
                     label = "Next",
                     class = "okay",
        )
      )
    )
    showModal(page1)
  })
}

shinyApp(ui, server)

解决方案 #

问题根源是justified = TRUE会强制所有按钮在同一行显示，小屏幕下无法自动换行。通过添加响应式CSS规则，可以让按钮在窄屏时自动堆叠成单列，并调整字体大小适配：

修改后的完整代码

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

# Functions-------
radio_inv <- function(id, label, width = "100%", ...) {
  shinyWidgets::radioGroupButtons(
    inputId = id,
    size = "sm",
    label = HTML("<h4>", label, "<span style='color:red'>*</span>", "</h4>"),
    choices = c(
      "Strongly Disagree",
      "Somewhat Disagree",
      "Disagree",
      "Agree",
      "Somewhat Agree",
      "Strongly Agree"
    ),
    selected = character(0),
    checkIcon = list(
      yes = icon("ok",
                 lib = "glyphicon"
      )
    ),
    width = width,
    justified = TRUE,
    ...
  )
}

# App ------------------------
ui <- bslib::page_fluid(
  tagList(
    # 添加响应式CSS
    tags$style(HTML("
      /* 小屏幕适配（宽度≤576px） */
      @media (max-width: 576px) {
        .btn-group-justified .btn-group {
          display: block !important;
          width: 100% !important;
          margin-bottom: 0.5rem;
        }
        .btn-group-justified .btn {
          width: 100% !important;
          font-size: 0.8rem;
        }
      }
    ")),
    # Button to start the questionnaire
    actionButton("start_intake",
                 label = "Start")
  ),
  theme = bs_theme(version = 5,
                   preset = "shiny")
)

server <- function(input, output, session) {
  observeEvent(input$start_intake, {
    survey_qs <- div(
      radio_inv("inv1", "I like sushi."),
      br(),
      br(),
      radio_inv("inv2", "I hate cake.")
    )
    page1 <- modalDialog(
      title = "Survey",
      survey_qs,
      footer = tagList(
        actionButton("submit",
                     label = "Next",
                     class = "okay",
        )
      )
    )
    showModal(page1)
  })
}

shinyApp(ui, server)

说明

• 媒体查询@media (max-width: 576px)针对Bootstrap定义的超小屏幕（手机等窄屏设备）生效。
• 将按钮组改为display: block，让每个按钮占满模态框宽度，自动堆叠成单列。
• 缩小按钮字体到0.8rem，避免长文本溢出按钮边界。
• 如果需要适配其他屏幕尺寸，可调整媒体查询的宽度阈值（比如768px对应平板）。

内容的提问来源于stack exchange，提问作者umair durrani