Force Rshiny UI to update UI element before a reactive that depends on it

Question

In Rshiny, I understand that we are trying to move away from the paradigm that we execute code 1 line after another and instead execute according to event-driven needs. However, this is causing an issue in an App that I am making to help my lab analyze our data that is causing a crash.

Here is a toy code that reproduces the issue I'm having. In the two code, the input$group1 and input$group2 haven't updated with actual values and pass along an NA, causing the dat variable in the scatterPlot render to be empty. In the real code, initialization is fine since the plot is in another tab, giving time for the update to occur. But while you're on the plot tab and you upload a file different file, the app crashes because its attempting to refer to the value in input$group1 which should be in man() but isn't since man() just updated.

You can also see my attempt to implement the fix found here: R Shiny: How to update an input object before a reactive statement gets executed

I was not able to make that work in the toy example, and have left my nonsense in there in case someone has the time to teach me what I'm missing, since our problems seem to be the same. That also includes my attempt to use freezeReactiveValue() from here: R Shiny - How to update a dependent reactive selectInput before updating dependent reactive plot

I also include two tab delimited input files.

shiny_test.R

library(shiny)
library(ggvis)

ui <-
  fluidPage(
    sidebarLayout(
      sidebarPanel(
        fileInput('man', 'Choose File',
                  accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv')),
        actionButton("load_button", "Load", width="100%"),
        selectInput(inputId = "group1",
                           label = "Groups:",
                    choices = NA),
        selectInput(inputId = "group2",
                           label = "Groups:",
                    choices = NA),
        width=4
      ),
      mainPanel(
        tabPanel("Scatter Plot", ggvisOutput("scatter_plot"))
      )
    )
  )

server <- function(input, output, session) {
  # Evaluate man on initialization and then only when the load button is pressed
  man = eventReactive(eventExpr = input$load_button, ignoreInit = FALSE, ignoreNULL = FALSE, {
    manName = ifelse(is.null(input$man$datapath), "default.txt", input$man$datapath)
    m = read.table(manName, sep = "\t", header = T, check.names=F)
    cat(names(m)) # This prints out the right names
    # freezeReactiveValue(input, "group1") # Causes an error with no error message
    # freezeReactiveValue(input, "group2") # Causes an error with no error message
    updateSelectInput(session, "group1", choices=names(m), selected=names(m[1]))
    updateSelectInput(session, "group2", choices=names(m), selected=names(m[1]))
    m
  })
  
  # The below is the same as putting them in the eventReactive
  # observe(updateSelectInput(session, "group1", choices=names(man()), selected=names(man()[1])))
  # observe(updateSelectInput(session, "group2", choices=names(man()), selected=names(man()[1])))
  
  # I tried my best to implement the fix from another question
  # group_selects <- reactiveValues(value1 = NULL, value2 = NULL)
  # observe({
  #   input$group1
  #   input$group2
  #   if(input$group1 %in% names(man())) {
  #     group_selects$value1 = input$group1
  #   } else {
  #     group_selects$value1 = NULL
  #   }
  #   if (input$group12 %in% names(man())) {
  #     group_selects$value2 = input$group2
  #   } else {
  #     group_selects$value2 = NULL
  #   }
  # })

  get_scatter_data <- reactive({
    cat(input$group1) # Why do these say NA?
    cat(input$group2) # How do I make the update happen before this?
    data.frame(groups = man()$group,
               a = man()[input$group1, ],
               b = man()[input$group2, ])
    
    # I tried my best to implement the fix from another question
    # data.frame(groups = man()$group,
    #            a = group_selects$value1,
    #            b = group_selects$value2)
  })
  
  scatterPlot <- reactive({
    dat = get_scatter_data()
    dat %>%
      ggvis(x = ~a, y = ~b) %>%
      layer_points(size := 80, size.hover := 240, fillOpacity := 0.7, fillOpacity.hover := 0.5, stroke:="black")
  })
  scatterPlot %>% bind_shiny("scatter_plot")
}

shinyApp(ui, server)

default.txt:

group x y
red  0.20844799 -0.4584187
blue  0.96430758  1.5591205
red  0.18576140 -1.3499559
blue -0.93537290 -0.3943987
red  0.09744085 -0.2205538
blue -1.70337618  0.1484331
red  1.83690192  0.4837242
blue  0.56866626 -1.3786314
red -1.57540872  0.2789504
blue -2.12494295  2.2122242

other.txt:

group           a           b
red  0.06569617  1.02374280
blue  0.60723671  1.63554065
red -1.13145728  2.25287719
blue -0.92389743  0.46868062
red -0.03210090  0.03540719
blue -0.12238044 -0.06535729
red  0.38296386 -1.30039148
blue  0.45646592 -0.85249368
red -1.09533079 -0.02886305
blue -0.22066367 -0.61954532

Here is the output I get when I remove the cat statements:

Listening on http://127.0.0.1:6003
Warning in data.frame(groups = man()$group, a = man()[input$group1, ], b = man()[input$group2,  :
  row names were found from a short variable and have been discarded
Warning: Error in rep: attempt to replicate an object of type 'closure'
  48: %>%
  47: server [C:/Users/Chronos/Desktop/shiny_test.R#76]
Error in rep(col, length.out = nrow(data)) : 
  attempt to replicate an object of type 'closure'
Warning: Error in rep: attempt to replicate an object of type 'closure'
  49: <Anonymous>
Warning: Error in rep: attempt to replicate an object of type 'closure'
  48: <Anonymous>

Answer 1

I managed to fix your code. Now the app works and you don't need the action button, which is better from a UX POV.

Notes: I change the files to CSV, because I couldn't copy/paste well as '\t' separated values.

As you can see in my code, I tried a more modular approach, creating objects in individual reactive calls.

library(shiny)
library(ggvis)
library(dplyr)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput(
        'man', 'Choose File',
        accept = c('txt/csv', 'text/comma-separated-value','.csv')
        ),
      #actionButton('load_button', 'Load', width = '100%'),
      selectInput('group1', 'Groups:', ''),
      selectInput('group2', 'Groups:', '')
    ),
    mainPanel(ggvisOutput('scatter_plot'))
  )
)

server <- function(input, output, session) {
  m <- reactive({
    manName <- ifelse(is.null(input$man$datapath), "default.txt", input$man$datapath)
    read.csv(manName, header =  TRUE)
  })
  
  observeEvent(m(), {
    freezeReactiveValue(input, "group1")
    freezeReactiveValue(input, "group2")
    updateSelectInput(session, "group1", choices = names(m()), selected = names(m())[2])
    updateSelectInput(session, "group2", choices = names(m()), selected = names(m())[3])
  })
  
  
  scatter_data <- reactive({
    select(m(), group, a = .data[[input$group1]], b = .data[[input$group2]])
  })
  
# The bind_shiny should be used within an observe function
  observe({
    scatter_data() %>%
      ggvis(x = ~a, y = ~b) %>%
      layer_points(size := 80, size.hover := 240, 
                   fillOpacity := 0.7, fillOpacity.hover := 0.5, 
                   stroke:="black") %>%
      bind_shiny("scatter_plot")
  })
  
}

shinyApp(ui, server)