如何在R Shiny应用中基于checkboxInput高亮radioButtons选项

解决方案思路 #

• 通过事件名动态关联对应复选框的ID，实时获取勾选状态
• 生成单选按钮时，用choicesNames定义显示文本（勾选事件用<strong>标签加粗），choicesValues定义实际提交值
• 设置escape = FALSE让HTML格式被正确渲染

修改后的完整代码 #

library(shiny)
library(bslib)

# 定义空值处理运算符，避免input未初始化时出错
`%||%` <- function(x, y) {
  if (is.null(x)) y else x
}

ui <- page_fluid(
  nav_panel(
    title = "Day1",
    navset_card_pill(
      nav_panel(title = "All",
                tagList(
                  br(),
                  actionButton("add", "New Event"),
                  br(),
                  tabsetPanel(id = "tabs")
                )),
      nav_panel(
        title = "Driver",
        uiOutput("event_of_interest_ui")
      )
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$add, {
    showModal(
      modalDialog(
        textInput(
          inputId = "event_name",
          label = "Event name:",
          value = ""
        ),
        actionButton("submit_event_name", "Submit"),
        title = "Enter event name",
        footer = NULL,
        size = "s",
        easyClose = FALSE
      )
    )
  })

  all_events <- reactiveValues(namez = NULL)

  event_name   <- reactive(input$event_name)
  tab_name     <- reactive(paste0("tab_", gsub("\\s", "", event_name())))

  observeEvent(input$submit_event_name, {
    removeModal()
    insertTab(
      inputId = "tabs",
      tabPanel(
        title = event_name(),
        checkboxInput(
          inputId = paste0(tab_name(), "_check"),
          label = p("Highlight this event for later discussion"),
          width = "600px"
        )
      )
    )
    all_events$namez <- c(all_events$namez, event_name())
  })

  output$event_of_interest_ui <- renderUI({
    if (!is.null(all_events$namez)){
      # 为每个事件生成对应的复选框ID
      checkbox_ids <- sapply(all_events$namez, function(event) {
        paste0("tab_", gsub("\\s", "", event), "_check")
      })
      # 根据勾选状态生成带格式的选项文本
      choice_names <- lapply(seq_along(all_events$namez), function(i) {
        current_event <- all_events$namez[i]
        is_checked <- input[[checkbox_ids[i]]] %||% FALSE
        if (is_checked) {
          HTML(paste0("<strong>", current_event, "</strong>"))
        } else {
          current_event
        }
      })
      radioButtons(
        inputId = "event_select",
        label = h4("Select event of interest:"),
        choicesNames = choice_names,
        choicesValues = all_events$namez,
        selected = character(0),
        width = 500,
        escape = FALSE  # 允许渲染HTML格式
      )
    } else {
      h4("请先在'All'页面创建至少一个事件。")
    }
  })
}

shinyApp(ui, server)

关键修改说明 #

1. 空值处理运算符：自定义%||%避免新创建事件的复选框未初始化时出现空值报错
2. 复选框ID关联：通过事件名动态生成对应复选框的ID，实现事件与勾选状态的绑定
3. HTML格式渲染：使用choicesNames定义显示文本，对勾选事件添加<strong>标签，配合escape=FALSE让加粗效果生效
4. 状态实时更新：每次复选框状态变化时，renderUI会自动重新生成单选按钮，保证显示与勾选状态同步

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