How to listen for multiple events which contain an isolate() in a shiny eventReactive handler

Question

Like in a previous question: How to listen for more than one event expression within a Shiny eventReactive handler

I\'m wanting to listen for two events in my eventR

Answer 1

I couldn't reproduce your example, so I'm not exactly sure what your problem is (see Friendly Tips, below), but I'll try to answer it based on your description.

But, first things first. You said that you are struggling with rv <- eventReactive(input$start |{req(input$nxt, isolate(input$choice))}, mysample(filenames)), right?

Well, one thing that we have to keep in mind if that when we are comparing things in R using thing 1 | thing 2, R only compares objects that are numeric, logical or complex. To see what I mean, type 1 | "a" and see what happens.

That being said, even if you had the correct syntax, R would not be able to compute input$start |{req(input$nxt, isolate(input$choice))} because the moment the user chooses "Left" or "Right", input$choice becomes a character and you would get the same error as in 1 | "a".

When you run rv <- eventReactive(input$start |input$nxt, mysample(filenames)), it works because both input$start and input$nxt have the same type.

Now, back to your problem: if I understood correctly, after you press "Start" you generate two numbers that will give you the file names. Then, you want to plot the respective images and the user has to select which one they prefer. Based on the selected image, you want to change the other image, selecting it at random from the remaining files. Is that it?

If that's the case, one way you could solve it would be by having two eventReactive statements. The first one to get the initial two numbers after the user presses "Start", and the other to update one of those two initial numbers, depending on the user choice.

The first one would have only one requirement:

rv.init <- eventReactive(input$start, {...})

While we could use the following for the second one (although input$start is redundant in this case):

  rv.cond <- eventReactive(input$start | input$nxt, {

    req(input$choice)
    ...
  })

You can see a working example here of the code below:

library(shiny)

ui <- fluidPage(
  # ADDED UI OUTPUTS ----------------------------------------------------------#
  fluidRow(h6("Original Filenames"), verbatimTextOutput("originalFilenames")),
  fluidRow(h6("Remaining Filenames"), verbatimTextOutput("remainingFilenames")),
  fluidRow(h6("Initial Sample"), verbatimTextOutput("initialSample")),
  fluidRow(h6("New Sample - user choice fixed"), verbatimTextOutput("newSample")),
  #----------------------------------------------------------------------------#
  fluidRow(uiOutput(outputId = "uiimg1"), uiOutput(outputId = "uiimg2")),
  fluidRow(uiOutput("radio")),
  fluidRow(uiOutput("nxt")),
  fluidRow(tags$div(HTML("<center>"),
                    actionButton("start", "Start"),
                    'id' = "strtbtn")))

server <- function(input, output) {

  # CHANGES TO THE ORIGINAL FUNCTION ------------------------------------------#

  # Generate file names
  orig.filenames <- 1:10

  # Create a reactive variable with filenames
  ## Reactive in the sense that we will update its values by removing the 
  ## selected ones
  filenames <- reactiveValues(names = orig.filenames)

  # Function to get 1 sample observation out of the remaining filenames
  mysample <- function(x){
    tmp <- sample(x,1)
    filenames$names <- setdiff(filenames$names, tmp)
    if(length(filenames$names) < 3) filenames$names <- orig.filenames
    tmp
  }

  #----------------------------------------------------------------------------#

  # CREATE EMPTY SAMPLE SET 

  files <- reactiveValues(sample = c(NA, NA))

  #----------------------------------------------------------------------------#

  # FIRST eventReactive -------------------------------------------------------#

  # Get initial sample of files when user clicks 'start'
  rv.init <- eventReactive(input$start, {

    ## Generate 1st time LEFT value
    left <- mysample(filenames$names)

    ## Generate 1st time RIGHT value
    right <- mysample(filenames$names)

    ## Create your initial sample in files$files
    tmp <- c(left, right)

    return(tmp)

  })

  # UPDATE SAMPLE SET WITH INITIAL VALUES
  observeEvent(input$start,  files$sample <- rv.init())

  #----------------------------------------------------------------------------#

  # SECOND eventReactive -------------------------------------------------------#

  # Get new sample file, based on user choice
  ## It will only update sample after user selects 'Left' or 'Right'
  rv.cond <- eventReactive(input$start | input$nxt, {

    req(input$choice)
    if (input$choice == "Left") {
      init.tmp <- files$sample
      init.tmp[2] <- mysample(filenames$names)
      tmp <- init.tmp
    }
    # Change first value (left value), if user selects "Right"
    else if (input$choice == "Right") {
      init.tmp <- files$sample
      init.tmp[1] <- mysample(filenames$names)
      tmp <- init.tmp
    }

    return(tmp)

  })

  # UPDATE SAMPLE SET WITH NEW VALUES
  observeEvent(input$nxt,  files$sample <- rv.cond())

  #----------------------------------------------------------------------------#

  observeEvent(input$start,
               {output$uiimg1<- renderUI(column(6, HTML("<center>Left Image"),
                                                fluidRow(imageOutput(outputId = "img1"))))})

  observeEvent(input$start,
               {output$uiimg2<- renderUI(column(6, HTML("<center>Right Image"),
                                                fluidRow(imageOutput(outputId = "img2"))))})

  observeEvent(input$start, 
               {output$nxt <- renderUI(wellPanel(HTML("<center>"),
                                                 actionButton("nxt","Next")))})
  observeEvent(input$start,
               {output$radio<- renderUI(
                 wellPanel(HTML("<center>"), 
                           radioButtons(inputId = "choice",
                                        label = "Which photo do you prefer?",
                                        c("Left", "Right"),
                                        inline = TRUE, selected = character (0)
                           )))})

  observeEvent(input$nxt,
               {output$radio<- renderUI(
                 wellPanel(HTML("<center>"), 
                           radioButtons(inputId = "choice",
                                        label = "Which photo do you prefer?",
                                        c("Left", "Right"),
                                        inline = TRUE, selected = character (0)
                           )))})

  observeEvent(input$start,
               removeUI(selector = "div:has(> #strtbtn)", immediate = TRUE))

  output$img1 <- renderImage({
    filename1 <- tempfile(fileext='.png')

    # CHANGED FROM THE ORIGINAL QUESTION --------------------------------------#
    # Set seed to filenames number from files$sample[1]
    set.seed(files$sample[1])

    # Generate a png
    png(filename1, width=325, height=214)
    hist(rnorm(50*files$sample[1]),  main = paste("Histogram of rnorm(50*" , files$sample[1], ")"))
    dev.off()
    #--------------------------------------------------------------------------#

    list(src = filename1, width=325, height=214)
  }, deleteFile= FALSE)

  output$img2 <- renderImage({
    filename2<- tempfile(fileext='.png')

    # CHANGED FROM THE ORIGINAL QUESTION --------------------------------------#
    # Set seed to filenames number from files$sample[2]
    set.seed(files$sample[2])

    # Generate a png
    png(filename2, width=325, height=214)
    hist(rnorm(50*files$sample[2]),  main = paste("Histogram of rnorm(50*" , files$sample[2], ")"))
    dev.off()
    #--------------------------------------------------------------------------#

    list(src = filename2, width=325, height=214)
  }, deleteFile= FALSE)

  # ADDED SERVER OUTPUTS ------------------------------------------------------#

  ## Print original filenames
  output$originalFilenames <- renderPrint({
    print(orig.filenames)
  })

  ## Print remaining filenames
  output$remainingFilenames <- renderPrint({
    print(filenames$names)
  })

  ## Print Initial Sample
  output$initialSample <- renderPrint({
    print(rv.init())
  })

  ## Print New Sample, keeping user choice fixed
  output$newSample <- renderPrint({
    req(input$start)
    print(files$sample)
  })

}

shinyApp(ui = ui, server = server)

---

Friendly Tips

When adding a working example, make sure it is reproducible. For instance, I don't have access to the folder /Users/Ben/Documents/Masters/Stats/Shiny/v8/www/, so I had to modify your code to make it work. If it takes us some time to understand/correct your code, it will take longer for you to get an answer.

More info on this can be found here: How to make a great R reproducible example?

Other than that, welcome to SO. =)