Shiny中更新textInput值时如何避免触发已观测事件

针对你遇到的两个问题，这里给出修复方案：

问题原因与修复思路 #

1. 重复触发确认弹窗：点击取消后用updateTextInput恢复输入框值，会再次触发input$bin的监听事件，此时高亮仍存在，导致弹窗重复出现。需要添加状态标志，区分用户手动修改和代码自动恢复输入的情况，避免重复触发弹窗。
2. 高亮标记消失：修改Bin时dat()重新计算，触发renderPlotly重新渲染整个图表，之前通过plotlyProxy添加的高亮trace会被清空。改为在渲染图表时直接包含高亮数据，确保图表更新时高亮不会丢失。

修复后的完整代码 #

df <- data.frame(t=seq(as.POSIXct("2024-01-01 00:00:00", tz='UTC'),
                        as.POSIXct("2024-01-02 00:00:00", tz='UTC'), by="1 hour"),
                 V1=sample(1:50,25, replace=T))

library(shiny)
library(plotly)
library(DT)
library(dplyr)
library(lubridate)

ui <- fluidPage(
  fluidRow(
    textInput("bin", HTML("Average by x hours"), 
              value = "1", width ='175px', placeholder = NULL),
    plotlyOutput("plot"),
    DTOutput("table")
  )
)

modal_confirm <- modalDialog(
  "This will remove all highlights. Are you sure you want to continue?",
  title = "",
  footer = tagList(
    actionButton("cancel", "Cancel"),
    actionButton("ok", "Continue")
  )
)

server<- function(input, output, session) {
  
  vals<-reactiveValues(
    highlights = data.frame(),
    prev_bin = "1",  # 初始化为默认值
    ignore_bin_update = FALSE  # 新增标志：是否忽略本次bin更新事件
  )
    
  # 数据处理
  dat<-reactive({
    req(vals$prev_bin)
    as.data.frame(df%>%
                   group_by(t=round_date(t, unit=paste0(vals$prev_bin,' hours')))%>%
                   summarize(V1=median(V1)))
  })
  
  # 绘制图表，包含高亮标记
  output$plot <- renderPlotly({
    p <- dat() %>%
      plot_ly() %>%
      add_trace(x= ~t, y = ~V1, type='scatter', mode='line', visible=TRUE) %>%
      layout(showlegend=FALSE)
    
    # 如果有高亮，添加高亮trace
    if(nrow(vals$highlights) > 0){
      p <- p %>%
        add_trace(x= ~t, y= ~V1, data=vals$highlights,
                  type='scatter', mode='markers',
                  marker = list(symbol='x', size=10, color='red'),
                  showlegend = FALSE)
    }
    p
  })
  
  # 处理点击高亮
  observeEvent(event_data("plotly_click"),{
    d <- event_data("plotly_click")
    # 确保点击的是主数据trace（index=0）
    if(d$curveNumber == 0){
      vals$highlights<-rbind(vals$highlights,dat()[d$pointNumber+1,]) 
    }
  })
  
  # 监听bin变化，带标志避免重复触发
  observeEvent(input$bin,{
    if(vals$ignore_bin_update){
      vals$ignore_bin_update <- FALSE  # 重置标志
      return()
    }
    
    if(nrow(vals$highlights) > 0 ){
      vals$prev_bin <- c(vals$prev_bin, input$bin)
      showModal(modal_confirm)
    }else{
      vals$prev_bin<-input$bin
    }
  })
  
  # 确认修改bin，删除高亮
  observeEvent(input$ok, {
    vals$prev_bin <- dplyr::last(vals$prev_bin)
    vals$highlights <- data.frame()
    removeModal()
  })
  
  # 取消修改，恢复bin值
  observeEvent(input$cancel, {
    vals$prev_bin<-vals$prev_bin[1]
    removeModal()
    # 设置标志，避免updateTextInput触发弹窗
    vals$ignore_bin_update <- TRUE
    updateTextInput(session, "bin", value = vals$prev_bin)
  })
  
  # 高亮数据表
  output$table<-renderDataTable({
      vals$highlights
  })  
  
}

shinyApp(ui,server)

关键修改说明 #

1. 新增ignore_bin_update标志：在取消操作时设置该标志为TRUE，随后调用updateTextInput恢复输入值，此时input$bin的监听事件会检测到标志并跳过弹窗逻辑，避免重复触发。
2. 图表渲染时包含高亮数据：不再使用plotlyProxy动态添加高亮trace，而是在renderPlotly中直接将高亮数据作为额外trace加入，这样当图表因Bin变化重新渲染时，高亮会自动保留。
3. 初始prev_bin赋值：给vals$prev_bin设置初始值为默认的"1"，避免初始时dat()因req(vals$prev_bin)等待。
4. 点击事件过滤：仅当点击主曲线（curveNumber == 0）时才添加高亮，防止点击高亮标记本身重复添加。

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