如何在R Shiny应用元素上创建超链接实现跳转并自动选中对应值

核心修改说明 #

• 给navbarPage添加唯一id，用于服务端控制标签页切换
• 替换原有超链接为带自定义属性的可点击元素，阻止默认跳转行为
• 引入shinyjs实现前端点击事件与Shiny服务端的通信
• 服务端监听点击事件，同步执行标签页切换和下拉选择器值更新

完整可运行代码 #

library(shiny)
library(DT)
library(data.table)
library(shinyjs)

server <- function(input, output, session) {
  
  output$uo_selector <- renderUI({
    selectizeInput(
      'si_letters', 'Letters', 
      choices = c("A", "B", "C"),
      multiple = FALSE, selected = "A")
  })
  
  df_table <- reactive({
    data.table(
      letters = c(
        "<a href='#' class='letter-link' data-val='A'>A</a>",
        "<a href='#' class='letter-link' data-val='B'>B</a>",
        "<a href='#' class='letter-link' data-val='C'>C</a>"
      ),
      numbers = c(1, 2, 3)
    )
  })
  
  output$dt_table <- renderDataTable(
    df_table(), escape = FALSE, options = list(pageLength = 5))
  
  # 监听点击事件，切换标签并更新下拉值
  observeEvent(input$clicked_letter, {
    updateNavbarPage(session, "main_nav", selected = "Letters")
    updateSelectizeInput(session, "si_letters", selected = input$clicked_letter)
  })
  
}

ui <- fluidPage(
  useShinyjs(),
  # 注册点击事件监听器
  tags$script(HTML("
    $(document).on('click', '.letter-link', function(e) {
      e.preventDefault();
      Shiny.setInputValue('clicked_letter', $(this).data('val'), {priority: 'event'});
    })
  ")),
  navbarPage('TEST', id = "main_nav",
             tabPanel("Table",
                      fluidPage(
                        fluidRow(dataTableOutput("dt_table")))),
             
             tabPanel("Letters",
                      fluidPage(
                        fluidRow(uiOutput("uo_selector"))))
             
  )
)

# Run the application 
shinyApp(ui, server)

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