У меня есть минимальное представление ниже. У меня две вкладки, и я хочу, чтобы данные загружались только во второй вкладке, когда пользователь нажимает на вторую вкладку. Фактические данные на второй вкладке поступают из API, поэтому я хочу, чтобы они загружались только при нажатии (а не каждый раз, когда загружается панель управления).
Я хочу, чтобы данные загружались и давали пользователям возможность добавить в это, добавив строку в набор данных.
Для этого представления я использовал набор данных iris. Я использовал reactiveValues, и, похоже, это работает нормально, за исключением одной проблемы. Это не ленивая загрузка, наборы данных радужной оболочки загружаются при загрузке панели управления (без перехода ко второй вкладке).
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)
Я попытался решить эту проблему с помощью вызова reactive () вместо этого, но теперь я получаю эту ошибку:
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]
Я думаю, что я близок и, вероятно, упускаю что-то действительно очевидное. TIA