反应值与反应；从 tabPanel [R Shiny] 延迟加载

Question

我在下面有一个最小代表。我有两个选项卡，我希望数据仅在用户单击第二个选项卡时加载到第二个选项卡中。第二个选项卡中的实际数据来自 API，所以我只希望它在单击时加载（而不是每次加载仪表板时）。

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

对于这个代表，我使用了鸢尾花数据集。我使用过 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

Answer 1

我认为应该可以让它与 reactive() 一起工作，但是当根据其自身的值修改反应式表达式时，很容易创建无限循环。另一种方法是使用 observeEvent() 来延迟创建 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

另一种解决方案是替换您的

  df$iris_df <- iris %>% 
    mutate(Species = as.character(Species))

与下面。

  observeEvent(input$tabs == "Iris", 
               {
                 df$iris_df <- iris %>% 
                   mutate(Species = as.character(Species))
                 print("Loaded Iris")
               },
               ignoreInit = TRUE,
               once = TRUE
  )

如您在控制台中所见，这会导致数据集在选项卡更改时加载，并且仅加载一次。

反应值与反应；从 tabPanel [R Shiny] 延迟加载

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

lazy-loading

r

shiny