reactiveValues vs反应性；从tabPanel延迟加载[R Shiny]

Question

我在下面有一个最小代表。我有两个标签，并且我希望仅当用户单击第二个标签时才将数据加载到第二个标签中。第二个选项卡中的实际数据来自API，因此我只希望在单击时加载（而不是每次加载仪表板时都加载）。

我希望加载数据，并通过向数据集添加一行，让用户选择添加到数据。

对于此代表，我使用了虹膜数据集。我使用了reactValues，除了一个问题外，这似乎工作正常。它不会延迟加载，虹膜数据集会在加载仪表盘时加载（无需导航至第二个选项卡）。

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)

我曾尝试通过使用react（）调用来解决此问题，但现在却收到此错误：

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

Answer 1

我认为应该使它与react（）一起工作，但是当根据其自身的值修改反应表达式中的表达式时，很容易创建无限循环。另一种方法是使用observeEvent（）延迟创建反应性值。

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)