How to Listen For More Than One Event Expression Within a Shiny Eventreactive Handler

How to listen for more than one event expression within a Shiny eventReactive handler

I know this is old, but I had the same question. I finally figured it out. You include an expression in braces and simply list the events / reactive objects. My (unsubstantiated) guess is that shiny simply performs the same reactive pointer analysis to this expression block as to a standard reactive block.

observeEvent({ 
  input$spec_button
  mainplot.click$click
  1
}, { ... } )

EDIT

Updated to handle the case where the last line in the expression returns NULL. Simply return a constant value.

How to listen for more than one event expression within a Shiny observeEvent

This should do it, note that you still have to check if the buttons were clicked as mentioned by @MrFlick

1. You can use reactive expression

#rm(list = ls())
library(shiny)
ui <- shinyUI(bootstrapPage(
  actionButton("test1", "test1"),
  actionButton("test2", "test2"))
)

server <- shinyServer(function(input, output) {

  toListen <- reactive({
    list(input$test1,input$test2)
  })
  observeEvent(toListen(), {
    if(input$test1==0 && input$test2==0){
      return()
    }
    print('Hello World')
  })
})

shinyApp(ui, server)

2. As per example given by @MrFlick (now deleted)

#rm(list = ls())
library(shiny)
ui <- shinyUI(bootstrapPage(
  actionButton("test1", "test1"),
  actionButton("test2", "test2"))
)

server <- shinyServer(function(input, output) {

  observeEvent(input$test1 | input$test2, {
    if(input$test1==0 && input$test2==0){
      return()
    }
    print('Hello World')
  })
})

shinyApp(ui, server)

How to implement eventReactive with multiple reactive eventExpr?

I found a solution. Perhaps not the most elegant, but it works.

The problem was that input$modelFilter and input$modelFilter were one update behind df2. This did not matter when the user selected input$update, since df2 did not update, and only posed a problem during a newly created df2, since the filter would not match the data.

To resolve this, I added values <- reactiveValues(update = 0) which will increase by +1 every time df3 is created, and will reset back to 0 when a new df2 is created. If values$update > 0 then the data is filtered, otherwise, the unfiltered data is returned.

Possibly useful link: How can I set up triggers or execution order for eventReactive or ObserveEvent?

require(shiny)
require(ggplot2)

ui <- fluidPage(
  titlePanel("Car Weight"),
  br(),
  uiOutput(outputId = "cylinders"),
  sidebarLayout(
    mainPanel(
      tableOutput("table"),
      uiOutput(outputId = "dataFilter"),
      actionButton(inputId = "update1", label = "Apply Filters"),
      width = 9
    ),
    sidebarPanel(
      actionButton(inputId = "update2", label = "Apply Filters"),
      uiOutput(outputId = "modelFilter"),
      actionButton(inputId = "update3", label = "Apply Filters"),
      width = 3
    )
  )
)

server <- function(input, output) {
  # Read data.  Real code will pull from database.
  df <- mtcars
  df$model <- row.names(df)
  df <- df[order(df$model), c(12,1,2,3,4,5,6,7,8,9,10,11)]

  # Get cylinders
  output$cylinders <- renderUI({
    selectInput(
      inputId = "cyl",
      label = "Select Cylinders",
      choices = c("", as.character(unique(df$cyl)))
    )})

  # Check if data frame has been updated.
  values <- reactiveValues(update = 0)

  # Subset data by cyl.
  df2 <-
    reactive({
      values$update <- 0
      df2 <- droplevels(df[df$cyl == input$cyl,])})

  # Filter data.
  df3 <-
    eventReactive({
      input$update1
      input$update2
      input$update3
      df2()
    },
    {
      if (values$update > 0) {
        req(input$modelFilter)
        modelFilterDf <-
          data.frame(model = input$modelFilter)
        df3a <-
          merge(df2(), modelFilterDf, by = "model")
        df3a <- df3a[df3a$wt >= input$dataFilter[1] &
                       df3a$wt <= input$dataFilter[2], ]
      } else {
        df3a <- df2()
      }

      values$update <- values$update + 1
      df3a
    },
    ignoreNULL = FALSE,
    ignoreInit = TRUE)

  # Plot table.
  output$table <- renderTable(df3())

  # Filter by data value.
  output$dataFilter <-
    renderUI({
      req(df2()$wt[1])
      sliderInput(
        inputId = "dataFilter",
        label = "Filter by Weight (1000 lbs)",
        min = floor(min(df2()$wt, na.rm = TRUE)),
        max = ceiling(max(df2()$wt, na.rm = TRUE)),
        value = c(floor(min(df2()$wt, na.rm = TRUE)),
                  ceiling(max(df2()$wt, na.rm = TRUE))),
        step = round(max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)) / 100,
        round = round(log((
          max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)
        ) / 100))
      )
    })

  # Filter by lot / wafer.
  output$modelFilter <- renderUI({
    req(input$cyl)
    checkboxGroupInput(
      inputId = "modelFilter",
      label = "Filter by Model",
      choices = as.character(unique(df2()$model)),
      selected = as.character(unique(df2()$model))
    )
  })
}

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

What is correct method for observing multiple events in Shiny?

You were close: put all reactive inputs to cause a trigger within braces.

Try this:

observeEvent({
  input$descr_daterange
  input$descr_decimals
  input$descr_radio
}, {
  descr_date_inds <- reactiveValues()
  descr_date_inds$begin_ind <- min(which(substr(inputData$qcdata$LDT,1,10) == input$descr_daterange[1]))
  descr_date_inds$end_ind <- max(which(substr(inputData$qcdata$LDT,1,10) == input$descr_daterange[2]))
  
  output$data_descr <- renderDataTable({
    description <- descr(inputData$qcdata[descr_date_inds$begin_ind:descr_date_inds$end_ind,],transpose = TRUE, stats = input$descr_radio)
    description <- description[-which(row.names(description) == 'RecNum'),]
    
    if ('N.Valid' %in% colnames(description) & 'Pct.Valid' %in% colnames(description)){
      description <- description[,-which(colnames(description) == 'N.Valid' | colnames(description) == 'Pct.Valid')]}
    
    description <- round2(description[,2:ncol(description)],input$descr_decimals)
    return(description)
    autoWidth = TRUE
    options=list(pageLength = 50)
  })
})

By-the-ways:

1. reactiveValues() tend to belong outside of reactive blocks, and used/referenced within them. I don't know the rest of your app nor how you intend to use them, so it might be that you don't need it at all (and are just using its list/env functionality), in which case you are carrying unneeded overhead by doing it this way.

2. You should never use & or | within an if conditional unless it is wrapped in any or all or some aggregating function. if requires its conditional to be exactly length 1, whereas &/| are vectorized logical ands/ors, meaning they can be length 0 or more.

   Even if both sides of the & are length-1, there is still a reason: && short-circuits, & does not.

   ### short-circuiting
   TRUE || stop("hello")
   # [1] TRUE
   
   ### not
   TRUE | stop("hello")
   # Error: hello
   

   Lastly, it's a bit declarative, in that by forcing yourself to use &&, you have to think about the length of the conditional. By using &, you're implying (to whomever is reading/using your code) that you will accept a result of length other than 1 ... which doesn't always work cleanly for if.

How to listen for more than one actionbutton within a Shiny observeEvent to reload shiny

You can add req to the observeEvent:

library(shiny)
ui <- shinyUI(
    bootstrapPage(
        p('cbldwbvkdj'),
        uiOutput('aa')
    )
)

server <- shinyServer(function(input, output, session) {
    
    output$aa <- renderUI({
        tagList(
            actionButton("test1", "test1"),
            actionButton("test2", "test2")
        )
    })
    
    observeEvent(list(input$test1, input$test2),{
        req(input$test1!=0 | input$test2 !=0)
        session$reload()
    }, ignoreInit = TRUE,ignoreNULL = TRUE)
})

shinyApp(ui, server)

Get the event which is fired in Shiny?

You can use shiny's JS event shiny:inputchanged to check which input changed:

ui <- fluidPage(
  tags$head(
    tags$script(
      "$(document).on('shiny:inputchanged', function(event) {
          if (event.name != 'changed') {
            Shiny.setInputValue('changed', event.name);
          }
        });"
    )
  ),
  numericInput("a", "a", 0),
  textInput("b", "b"),
  textInput("c", "c"),
  textOutput("changedInputs"),
  textOutput("aFired")
)

server <- function(input, output, session) {
  output$changedInputs <- renderText({
    paste("Outside observer: Latest input fired:", paste(input$changed, collapse = ", "))
  })
  
  observeEvent({
    c(input$a,
      input$b)
  }, {
    req(input$changed)
    if (input$changed == "a") {
      output$aFired <- renderText("Inside observer: input$a was fired")
    } else if (input$changed == "b") {
      output$aFired <- renderText("Inside observer: input$b was fired")
    } else if (input$changed == "c") {
      output$aFired <- renderText("Inside observer: input$c was fired")
    }
  }, ignoreInit = TRUE)
}

shinyApp(ui, server)

---

:

Edit - request from @TristanTran using renderUI:

library(shiny)

ui <- fluidPage(
  tags$head(
    tags$script(
      "$(document).on('shiny:inputchanged', function(event) {
          if (event.name != 'changed') {
            Shiny.setInputValue('changed', event.name);
          }
        });"
    )
  ),
  uiOutput("serverside"),
  textOutput("changedInputs"),
  textOutput("aFired")
)

server <- function(input, output, session) {
  output$changedInputs <- renderText({
    paste("Outside observer: Latest input fired:", paste(input$changed, collapse = ", "))
  })
  
  output$serverside <- renderUI({
    tagList(
      numericInput("a", "a", 0),
      textInput("b", "b"),
      textInput("c", "c")
    )
  })
  
  observeEvent({
    c(input$a,
      input$b)
  }, {
    req(input$changed)
    if (input$changed == "a") {
      output$aFired <- renderText("Inside observer: input$a was fired")
    } else if (input$changed == "b") {
      output$aFired <- renderText("Inside observer: input$b was fired")
    } else if (input$changed == "c") {
      output$aFired <- renderText("Inside observer: input$c was fired")
    }
  }, ignoreInit = TRUE)
}

shinyApp(ui, server)

Shiny observeEvent expression runs more than once

Its because a new observer is created for all the existing delete buttons when Add Item is clicked. This can be fixed by tracking which button has been clicked and creating an observer for only the new button created. I'm sure this can be worked into the example you have provided above, however, personally this was a little difficult to follow with the use of splat and mapply. Anyway, the addition of new button can be simplified with the use of a tagList.

library(shiny)

ui <- fluidPage(
  actionButton("addItem", "Add Item"),
  uiOutput("items")
)



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

  new_bttn_added <- reactiveVal(0) #index to track new button
  delete_id <- c() #IDs of the delete buttons
  index <- 1 #Counter
  taglist <- tagList() #Button Taglist to display in uiOutput("items")

  output$items <- renderUI({
    req(input$addItem) # reactivity when addItem is clicked

    delete_id <<- c(delete_id,paste0("bttn",index)) #Append the new ID of the button being created
    taglist <<- tagList(taglist,div(actionButton(delete_id[index],"Delete"))) #Append button to taglist
    index <<- index + 1 #Increment index

    #Increment the button counter
    isolate({
      val <- new_bttn_added()
      val <- val + 1
      new_bttn_added(val)
    })
    return(taglist)
  })

  observe({
    #This section is triggered only when a new button is added
    # Reactive dependance on only new_bttn_added() to avoid race conditions

    id <- delete_id[new_bttn_added()]
    lapply(id,function(x){
      observeEvent(input[[x]],{
        # Do something with the new delete button here
        cat("Pressed",x,"\n")
      })
    })
  })
}

shinyApp(ui = ui, server = server)

How to put 2 possibles eventReactive in only one variable

Building off of this thread the following seems to achieve the desired behavior (if I understand everything correctly):

library(shiny)

my_fun <- function() {
   x <- sample(x=nrow(iris), size = 6)
   x
}

ui <- fluidPage(
    tabsetPanel(
    tabPanel(title = "panel1",
            actionButton("go1", "go 1")),
    tabPanel(title = "panel2",
            actionButton("go2", "go 2"))
    ),
     mainPanel(dataTableOutput("tab"))
    )

server <- function(input, output) {
    df <- eventReactive(c(input$go1, input$go2), {
    iris[my_fun(),]
     }, ignoreNULL = FALSE, ignoreInit = TRUE)

output$tab <- renderDataTable({
    df()
 })
}

shinyApp(ui, server)

See also ?eventReactive for the ignoreNULL and ignoreInit options.

Edit: Two functions, one eventReactive, and keep track of tabs to know what to render.

library(shiny)
library(dplyr)

go1_fun <- function() {
  x <- filter(iris, Species == "setosa") %>% head
  x
}

go2_fun <- function() {
  x <- filter(iris, Species == "virginica") %>% head
  x
}

ui <- fluidPage(
  tabsetPanel(id = "tabs", 
    tabPanel(title = "panel1",
             actionButton("go1", "go 1")),
    tabPanel(title = "panel2",
             actionButton("go2", "go 2"))
  ),
    mainPanel(dataTableOutput("tab"))
  )

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

  df1 <- reactive({
    if (req(input$go1)) {
        x <- go1_fun()
    }
    return(x)
  })

  df2 <- reactive({  
    if (req(input$go2)) {
        x <- go2_fun()
    }
    return(x)
  })

  tab_to_render <- eventReactive(c(input$go1, input$go2), {
    if (input$tabs == "panel1") x <- df1()
    if (input$tabs == "panel2") x <- df2()

    return(x)
  }, ignoreNULL = FALSE, ignoreInit = TRUE)

  output$tab <- renderDataTable({
    tab_to_render()
  })
}

shinyApp(ui, server)

---

Related Topics