Question

我有一个使用模块概念的应用程序，其中每个tabPanel本质上都是其自己的模块。我进行了设置，以便每个模块都从光盘读取其自己的数据集。问题是我希望能够使用该数据集动态填充模块中的 select输入。这很容易实现，但是要注意的是，当我在模块中填充选择输入时，使用updateSelectInput()会触发在应用加载时（而不是在打开/导航到模块时）运行模块数据读取。

我创建了一个小示例来说明dat()是如何过早运行的。在我的实际项目中，这是一个很大的问题，因为这意味着所有数据都是预先加载而不是在导航时加载的，这使其非常缓慢且效率低下。

任何想法如何避免这种情况？

library(shiny)
library(dplyr)

module_ui <- function(id, ...) {
    ns <- NS(id)

    tagList(
        "This is the module UI.",
        selectInput(ns("model"), "Select car model:", choices = NULL),
        textOutput(ns("result"))
        )
}

module_server <- function(input, output, session, ...) {

    dat <- reactive({
        # this is where data would be read from disc
        print("Data reading triggered!")
        out <- rownames_to_column(tbl_df(mtcars), "model")
        out
    })

    output$result <- renderText({
        paste("Miles per gallon is", pull(filter(out, model == input$model), "mpg"))
    })


    observe({
        updateSelectInput(session, inputId = "model", choices = dat()$model)
    })
}

ui <- navbarPage("App Title",
                 tabPanel("Tab A", "This is just a landing page."),
                 tabPanel("Tab B", module_ui(id = "my_module"))
)

server <- function(input, output) {

    callModule(module = module_server, id = "my_module")
}

shinyApp(ui = ui, server = server)

Answer 1

根据我的答案here改编了（id需要navbarPage）

library(shiny)
library(dplyr)
library(tibble)

print(paste("App start:", Sys.time()))

module_ui <- function(id, ...) {
  ns <- NS(id)

  tagList(
    "This is the module UI.",
    selectInput(ns("model"), "Select car model:", choices = NULL),
    textOutput(ns("result"))
  )
}

module_server <- function(input, output, session, ...) {

  dat <- reactive({
    # this is where data would be read from disc
    print(paste(Sys.time(), "Data reading triggered!"))
    out <- rownames_to_column(tbl_df(mtcars), "model")
    out
  })

  output$result <- renderText({
    paste("Miles per gallon is", pull(filter(dat(), model == input$model), "mpg"))
  })

  observe({
    updateSelectInput(session, inputId = "model", choices = dat()$model)
  })
}

ui <- navbarPage("App Title", id = "navbarID",
                 tabPanel("Tab A", "This is just a landing page."),
                 tabPanel("Tab B", module_ui(id = "my_module"))
)

server <- function(input, output) {

  observeEvent({input$navbarID=="Tab B"},{
      callModule(module = module_server, id = "my_module")
  }, once = TRUE, ignoreInit = TRUE)
}

shinyApp(ui = ui, server = server)

Answer 2

尝试以下操作：

提供sidebarMenu和ID，例如。 id =“ tabs”
做一个观察者：测试

observeEvent(input$tabs, {
    if(input$tabs == "tabID"){     
        # Do something     
    }     
})

使用“ tabID”替换您要加载数据的标签的ID（如果已选择）。

如何避免模块代码过早运行？

2 个答案: