Shiny中如何仅当分类变化时触发对应响应式事件？

我有一个返回字符串的响应式输入，字符串包含分类和条目两部分信息，我希望部分事件仅在分类发生变化时触发，条目变更时不触发，即需要对事件进行条件化隔离，让响应式函数仅根据事件的实际值判断是否调用。

现有演示代码如下：

library(shiny)

ui <- fluidPage(
         fluidRow(
                  selectInput("selection", "Select:", 
                              choices=c("catA:itemA", "catA:itemB", "catB:itemC"))),
         fluidRow("Category:", textOutput("category")),
         fluidRow("Item:",     textOutput("item"))

      )

server <- function(input, output) {

  .cat  <- reactive({ gsub(":.*", "", input$selection) })
  .item <- reactive({ gsub(".*:", "", input$selection) })

  output$category <- renderText({
    ## 分类未变化时不应当触发本段代码
    message("Triggered category change")
    .cat()
  })

  output$item <- renderText({
    message("Triggered item change")
    .item()
  })
}

shinyApp(ui, server)

上述代码无法满足预期需求，我希望output$category <- renderText({...})当且仅当.cat()的值发生变化时才触发，请问该如何实现这一需求？

方案1：显式状态控制（全版本兼容，可控性最强） #

通过独立的响应式变量存储分类、条目的状态，仅在值实际变更时更新状态，再让输出依赖对应状态即可实现精准触发，修改后的服务端代码如下：

server <- function(input, output) {
  # 定义响应式变量存储分类和条目
  current_cat <- reactiveVal()
  current_item <- reactiveVal()

  # 监听输入变化，仅当值实际变更时更新响应式变量
  observeEvent(input$selection, {
    parts <- strsplit(input$selection, ":", fixed = TRUE)[[1]]
    new_cat <- parts[1]
    new_item <- parts[2]
    
    # 分类与旧值不同才更新
    if (!identical(new_cat, isolate(current_cat()))) {
      current_cat(new_cat)
    }
    # 条目与旧值不同才更新
    if (!identical(new_item, isolate(current_item()))) {
      current_item(new_item)
    }
  })

  output$category <- renderText({
    message("Triggered category change")
    current_cat()
  })

  output$item <- renderText({
    message("Triggered item change")
    current_item()
  })
}

说明 #

• 用reactiveVal定义的状态变量只有主动调用赋值函数时才会变更，不会被上游输入直接触发
• 监听输入时用isolate获取旧状态值避免不必要的依赖，仅在新旧值不一致时更新状态
• 输出组件仅依赖对应的状态变量，只有状态更新时才会触发重渲染，完全符合需求

方案2：缓存绑定（适合Shiny 1.6.0及以上版本，写法简洁） #

直接对reactive表达式使用bindCache，将缓存key设置为提取后的分类/条目值，只有key发生变化时才会更新reactive状态，进而触发下游输出：

server <- function(input, output) {
  .cat  <- reactive({
    gsub(":.*", "", input$selection)
  }) %>% bindCache(gsub(":.*", "", input$selection))
  .item <- reactive({
    gsub(".*:", "", input$selection)
  }) %>% bindCache(gsub(".*:", "", input$selection))

  output$category <- renderText({
    message("Triggered category change")
    .cat()
  })

  output$item <- renderText({
    message("Triggered item change")
    .item()
  })
}

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