Force observeEvent after update with updateTextInput

[Andy_B]

Hi,

How can I force processing of observeEvent if I update an input value with updateTextInput, when the old value is the same as the new one?

Essentially I want "updateTextInput(session, "sim_slider_text", value = val1)" (where val1 is the current value of sim_slider_text) to execute the code under observeEvent(input$myslider).

I can update the Slider value either with the slider or in the textbox below, and the result is re-calculated.

However, when I change the "Factor" text, the re-calculation is not done (it is only done after either of the slider values is changed again).

So how can I get Result to be re-calculated when I change Factor?

library(shiny)
library(shinythemes)
library(shinyWidgets)
library(shinyjs)

### Start ui ####
ui <- fluidPage(
 titlePanel("Test"),
 fluidRow(
  column(10,
         tabsetPanel(
          tabPanel("Test",
                   fluidRow(
                    column(
                     6, h1('Input data'), hr(),
                     textOutput("dummy"),
                     textInput("factor", "Factor", value=2),
                     uiOutput("sim_slider"),
                     textInput("sim_slider_text", "or enter Slider value here:", value=0),
                     htmlOutput("out_result"),
                    )))))))

### Start server ####
server <- function(input, output, session) {
 output$dummy <- renderText({
  output$sim_slider <- renderUI({
   sliderTextInput(
    inputId = "myslider",
    label = "Slider:", 
    choices = seq(from = 0, to = 10, by = 0.5),
    selected =  4.5,
    grid = FALSE
   )
  })
  x <- ""
  x
 })

 observeEvent(input$factor, {
  x <- input$factor
  mysl <- input$myslider
  req(mysl)
  print(paste("mysl: ", mysl, typeof(mysl)))


  ### PROBLEM ####
  # the following does not work, I tried to fool shiny with the multiplication, but it doesn't help.
  updateTextInput(session, "sim_slider_text", value = mysl * 1)
 })
 
 observeEvent(input$myslider, {
  print(paste("input$myslider:", input$myslider))
  x <- input$myslider
  req(input$myslider)
  req(input$factor)
  calc_result <- as.numeric(input$myslider) * as.numeric(input$factor)
  output$out_result <- renderText({ paste0('Result: ', calc_result) })
  if(as.numeric(input$sim_slider_text) != input$myslider) {
   updateTextInput(session, "sim_slider_text", value = x)
  }
  
 }, ignoreNULL = FALSE, ignoreInit = TRUE)
 
 observeEvent(input$sim_slider_text, {
  req(input$sim_slider_text)
  req(input$myslider)
  print(paste("input$sim_slider_text:", input$sim_slider_text))
  if(as.numeric(input$sim_slider_text) != input$myslider) {
   x <- input$sim_slider_text
   updateSliderTextInput(session, "myslider", selected = as.numeric(x))
  }
 }, ignoreNULL = FALSE, ignoreInit = TRUE)
 

}

### Run shiny ####
shinyApp(ui = ui, server = server)

[pieterjanvc]

Hi,

Welcome to the forum.

You can solve this issue by adding both input events to the same observeEvent like this:

  observeEvent(c(input$myslider, input$factor), {
    x <- input$myslider
    req(input$myslider)
    req(input$factor)
    calc_result <- as.numeric(input$myslider) * as.numeric(input$factor)
    output$out_result <- renderText({ paste0('Result: ', calc_result) })
    if(as.numeric(input$sim_slider_text) != input$myslider) {
      updateTextInput(session, "sim_slider_text", value = x)
    }
    
  }, ignoreNULL = FALSE, ignoreInit = TRUE)

You can now delete the code that has the observeEvent for input$factor and put all its logic here. Now the event will be executed if either myslider or factor change.

Hope this helps,
PJ

[nirgrahamuk]

I would radically restructure the app along the following lines:

library(shiny)
library(shinyWidgets)

### Start ui ####
ui <- fluidPage(
  titlePanel("Test"),
  fluidRow(
    column(10,
           tabsetPanel(
             tabPanel("Test",
                      fluidRow(
                        column(
                          6, h1('Input data'), hr(),
                          textInput("factor", "Factor", value=2),
                          sliderTextInput(
                            inputId = "myslider",
                            label = "Slider:", 
                            choices = seq(from = 0, to = 10, by = 0.5),
                            selected =  4.5,
                            grid = FALSE
                          ),
                          textInput("sim_slider_text", "or enter Slider value here:", value=4.5),
                          verbatimTextOutput("synchronise_slider"),
                          htmlOutput("out_result"),
                        )))))))

### Start server ####
server <- function(input, output, session) {

   slid <-reactiveVal(NULL)
   
 
      
  observeEvent(input$myslider, {
    if( ! identical(input$myslider,slid()))
      slid(input$myslider)
  })
  
  observeEvent(input$sim_slider_text, {
    if( ! identical(input$sim_slider_text,slid()))
      slid(as.numeric(input$sim_slider_text))
  })
  
  observeEvent(
    slid(),
    {
      updateSliderTextInput(session=session,
                            inputId = "myslider",
                            selected = slid())
      updateTextInput(session=session,
                      inputId = "sim_slider_text",
                      value = slid())
    })
  
  output$synchronise_slider <- renderText({
    paste0("synchronised ",
    slid())
  })
  
  calc_result <- reactive({
    x <- req(slid())
    y <- req(input$factor)
    calc_result <- as.numeric(x) * as.numeric(y)
  })
  
  
  output$out_result <- renderText({ paste0('Result: ',
                                           req(calc_result())) })
}

shinyApp(ui, server)

[Andy_B]

Hello PJ,

Thanks alot! I wasn't aware of the possiblity to pass multiple arguments to observeEvent. I had tried several dirty workarounds before. Your solution does just exactly what I wanted, perfect!

Thanks again,
Andy

[Andy_B]

Nice solution, many thanks for posting it!