reactiveValues vs reactive; lazy loading from tabPanel [R Shiny] - r

Question

I have a min reprex below. I have two tabs and I want the data to only load in the second tab when an user clicks on the second tab. The actual data in the second tab comes from an API so I only want it to load upon clicking (and not everytime the dashboard is loaded).
I want the data to load and give users a choice to add to it, by appending a row to the dataset.
For this reprex I have used iris dataset. I have used reactiveValues, and this seems to work fine except for one problem. It doesn't lazy load, the iris datasets get loaded when the dashboard is loaded (without having to navigate to the second tab).
library(shiny)
library(dplyr)
ui <- fluidPage(
navlistPanel(
tabPanel(
title = "Main Page" # Empty
)
,tabPanel(
title = "Iris"
,fluidRow(
column(
width = 6
,uiOutput(outputId = "choose_species")
)
,column(
width = 6
,uiOutput(outputId = "add_species")
,uiOutput(outputId = "add_measure")
,uiOutput(outputId = "ok")
)
)
,fluidRow(
column(
width = 6
,verbatimTextOutput(outputId = "print_df")
)
)
)
)
)
server <- function(input, output) {
df <- reactiveValues(iris_df = NULL)
observe({
print(is.null(df$iris_df))
})
df$iris_df <- iris %>%
mutate(Species = as.character(Species))
observe({
print(is.null(df$iris_df))
})
output$choose_species <- renderUI({
selectInput(
inputId = "input_choose_species"
,label = "Choose Species"
,choices = df$iris_df %>% distinct(Species)
)
})
output$add_species <- renderUI({
textInput(
inputId = "input_add_species"
,label = "Add Species"
,value = ""
)
})
output$add_measure <- renderUI({
numericInput(
inputId = "input_add_measure"
,label = "Add Measurements"
,value = ""
)
})
output$ok <- renderUI({
actionButton(
inputId = "input_ok"
,label = "Add New Species"
)
})
observeEvent(input$input_ok, {
req(
input$input_add_species
,input$input_add_measure
)
new_row <- c(rep(input$input_add_measure, 4), input$input_add_species)
df$iris_df <- df$iris_df %>% rbind(new_row)
})
output$print_df <- renderPrint({
req(input$input_choose_species)
df$iris_df %>%
filter(Species == input$input_choose_species)
})
}
shinyApp(ui = ui, server = server)
I have tried to solve this issue by using reactive() call instead, but now I am getting this error instead:
server <- function(input, output) {
df <- reactive({
iris %>%
mutate(Species = as.character(Species))
})
output$choose_species <- renderUI({
selectInput(
inputId = "input_choose_species"
,label = "Choose Species"
,choices = df() %>% distinct(Species)
)
})
output$add_species <- renderUI({
textInput(
inputId = "input_add_species"
,label = "Add Species"
,value = ""
)
})
output$add_measure <- renderUI({
numericInput(
inputId = "input_add_measure"
,label = "Add Measurements"
,value = ""
)
})
output$ok <- renderUI({
actionButton(
inputId = "input_ok"
,label = "Add New Species"
)
})
df <- eventReactive(input$input_ok, {
req(
input$input_add_species
,input$input_add_measure
)
new_row <- c(rep(input$input_add_measure, 4), input$input_add_species)
df() %>% rbind(new_row)
})
output$print_df <- renderPrint({
req(input$input_choose_species)
df() %>%
filter(Species == input$input_choose_species)
})
}
shinyApp(ui = ui, server = server)
Warning: Error in : evaluation nested too deeply: infinite recursion / options(expressions=)?
[No stack trace available]
I think I am close and probably missing something really obvious. TIA

Answer 1

I think it should be possible to make it work with reactive(), but it is easy to create an infinite loop, when modifying a reactive expression based on its own value.
An other approach is to use observeEvent() to delay creating a reactiveValue.
library(shiny)
library(dplyr)
ui <- fluidPage(
navlistPanel(id = 'tabs', # set id to allow the server to react to tab change
tabPanel(title = "Main Page" # Empty
)
,tabPanel(title = "Iris" # Title is value if no value is set
,fluidRow(
column(
width = 6
,uiOutput(outputId = "choose_species")
)
,column(
width = 6
,uiOutput(outputId = "add_species")
,uiOutput(outputId = "add_measure")
,uiOutput(outputId = "ok")
)
)
,fluidRow(
column(
width = 6
,verbatimTextOutput(outputId = "print_df")
)
)
)
)
)
server <- function(input, output) {
df = reactiveVal()
observeEvent(input$tabs, {
req(is.null(df()))
if (input$tabs == 'Iris') df(mutate(iris, Species = as.character(Species)))
})
output$choose_species <- renderUI({
req(df())
selectInput(
inputId = "input_choose_species"
,label = "Choose Species"
,choices = df() %>% distinct(Species)
)
})
output$add_species <- renderUI({
textInput(
inputId = "input_add_species"
,label = "Add Species"
,value = ""
)
})
output$add_measure <- renderUI({
numericInput(
inputId = "input_add_measure"
,label = "Add Measurements"
,value = ""
)
})
output$ok <- renderUI({
actionButton(
inputId = "input_ok"
,label = "Add New Species"
)
})
observeEvent(input$input_ok, {
req(
input$input_add_species
,input$input_add_measure
)
new_row <- c(rep(input$input_add_measure, 4), input$input_add_species)
df(df() %>% rbind(new_row))
})
output$print_df <- renderPrint({
req(input$input_choose_species)
df() %>%
filter(Species == input$input_choose_species)
})
}
shinyApp(ui = ui, server = server)

Answer 2

An alternative solution would be to replace your
df$iris_df <- iris %>%
mutate(Species = as.character(Species))
with the below.
observeEvent(input$tabs == "Iris",
{
df$iris_df <- iris %>%
mutate(Species = as.character(Species))
print("Loaded Iris")
},
ignoreInit = TRUE,
once = TRUE
)
As you can see in the console, this causes the dataset to be loaded on tab change, and only once.