In R shiny, how to make 'observeEvent' NOT get triggered by changes from 'updateSelectizeInput'

Question

How to make 'observeEvent' NOT get triggered by changes from 'updateSelectizeInput'

In this example code, the data table 'value$data' and the 'render data table' on the right side is to simulate a SQL database that's getting updated by action on the left.

by selecting different 'cars' on selectize1(cars), the selectize2(HP) will be updated based on what's currently on the 'database'.

When the user changes the selectize2(HP), the 'observeEvent' will update the 'database' with the new HP of the selected car.

The problem is: when the user changes the selected car(selectize1), updateSelectizeInput will lead to an unnecessary trigger on the 'observeEvent' and an unnecessary update in the database.

Any suggestion on how to avoid this issue?

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)

my current solution is to save the value in a reactive value before the 'updateSelectizeInput' and do a comparison inside the observeEvent for 'hp'. Hoping there is a better way to do this.

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)

Perhaps you could add an actionButton() to initiate writing to the database? — PLY
Reactivity behaves the way it should, you will need to control it like you did on your side with extra code — Pork Chop

Thomas Thomas · Accepted Answer · 2020-12-03T12:26:41

There is no need to save the state in a reactive value, you can use it directly for comparison. Hence, this is a more direct approach compared to your current solution though still with the if statement (if you are looking for a solution without, please comment).

Here you have the server code without using 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)
  
}

In R shiny, how to make 'observeEvent' NOT get triggered by changes from 'updateSelectizeInput'

1 Answers