r - 在 R 中，如何使 'observeEvent' 不会被 'updateSelectizeInput' 的更改触发

Question

如何使“observeEvent”不被“updateSelectizeInput”更改触发
在此示例代码中，右侧的数据表“value$data”和“渲染数据表”用于模拟 SQL 数据库，该数据库通过左侧的操作进行更新。
通过在 selectize1(cars) 上选择不同的“cars”，selectize2(HP) 将根据“数据库”上的当前内容进行更新。
当用户更改 selectize2(HP) 时，“observeEvent”将使用所选汽车的新 HP 更新“数据库”。
问题是:当用户更改选定的汽车 (selectize1) 时，updateSelectizeInput 将导致 'observeEvent' 上不必要的触发器和数据库中不必要的更新。
关于如何避免这个问题的任何建议？

library(shiny)
library(tibble)
library(dplyr)
library(shinyjs)
value <- reactiveValues()
dt <- mtcars %>% 
  rownames_to_column(var = 'cars') %>% 
  slice_head(n = 5) %>% 
  select(cars, mpg, hp)
value$data <- dt


ui <- fluidPage(    
  titlePanel("Example App"),
  sidebarLayout(      
    sidebarPanel(
      shinyjs::useShinyjs(),
      div(style="display: inline-block;",
        selectizeInput("cars", "Cars:", 
                    choices=dt$cars,width = 200)
      ),
      div(style="display: inline-block;",
        selectizeInput(
          'hp',"hp:",
          choices = unique(dt$hp),
          width = 200)
      ),
      helpText("You can change cars hp info here"),
      div(id='actions','actions:')
    ),
    mainPanel(
      dataTableOutput("datatable1")
    )
    
  )
)

# Define the server code
server <- function(session,input, output) {
  observeEvent(input$cars,{
    updateSelectizeInput(session,'hp',selected = value$data$hp[value$data$cars==input$cars])
  })
  
  observeEvent(input$hp,{
    value$data$hp[value$data$cars==input$cars] <- input$hp
    shinyjs::html(
      id = 'actions',
      add = TRUE,
      html = paste0('<br> updated dt table at ', input$cars, 'on ', Sys.time())
    )
  })
    output$datatable1 <- renderDataTable(value$data)
    
}
 
# Return a Shiny app object
shinyApp(ui = ui, server = server)

我目前的解决方案 是在“updateSelectizeInput”之前将值保存在 react 值中，并在“hp”的observeEvent内进行比较。
希望有更好的方法来做到这一点。

library(shiny)
library(tibble)
library(dplyr)
library(shinyjs)
value <- reactiveValues()
dt <- mtcars %>% 
  rownames_to_column(var = 'cars') %>% 
  slice_head(n = 5) %>% 
  select(cars, mpg, hp)
value$data <- dt

saveValue <- reactiveValues()
saveValue$value <- ''


ui <- fluidPage(    
  titlePanel("Example App"),
  sidebarLayout(      
    sidebarPanel(
      shinyjs::useShinyjs(),
      div(style="display: inline-block;",
          selectizeInput("cars", "Cars:", 
                         choices=dt$cars,width = 200)
      ),
      div(style="display: inline-block;",
          selectizeInput(
            'hp',"hp:",
            choices = unique(dt$hp),
            width = 200)
      ),
      helpText("You can change cars hp info here"),
      div(id='actions','actions:')
    ),
    mainPanel(
      dataTableOutput("datatable1")
    )
    
  )
)

# Define the server code
server <- function(session,input, output) {
  observeEvent(input$cars,{
    saveValue$value <- value$data$hp[value$data$cars==input$cars]
    updateSelectizeInput(session,'hp',selected = value$data$hp[value$data$cars==input$cars])
  })
  
  observeEvent(input$hp,ignoreInit = TRUE,{
    if(saveValue$value!=input$hp){
      value$data$hp[value$data$cars==input$cars] <- input$hp
      shinyjs::html(
        id = 'actions',
        add = TRUE,
        html = paste0('<br> updated dt table at ', input$cars, 'on ', Sys.time())
      )
    }
  })
  output$datatable1 <- renderDataTable(value$data)
  
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

Answer 1

无需将状态保存在 react 值中，您可以直接使用它进行比较。因此，尽管仍然使用 if 语句，但与您当前的解决方案相比，这是一种更直接的方法(如果您正在寻找没有的解决方案，请发表评论)。
这里你有服务器代码而不使用 saveValue

server <- function(session,input, output) {
  observeEvent(input$cars,{
    updateSelectizeInput(session,'hp',selected = value$data$hp[value$data$cars==input$cars])
  })
  
  observeEvent(input$hp,ignoreInit = TRUE,{
    checkValue <- value$data$hp[value$data$cars==input$cars]
    if(checkValue != input$hp){
      value$data$hp[value$data$cars==input$cars] <- input$hp
      shinyjs::html(
        id = 'actions',
        add = TRUE,
        html = paste0('<br> updated dt table at ', input$cars, 'on ', Sys.time())
      )
    }
  })
  output$datatable1 <- renderDataTable(value$data)
  
}