时间戳

首页 > 解决方案 > 如何避免模块代码过早运行？

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

问题描述

我有一个使用模块概念的应用程序，基本上每个tabPanel模块都是它自己的模块。我进行了设置，以便每个模块从光盘中读取自己的数据集。问题是我希望能够使用该数据集动态填充模块中的选择输入。这很容易实现，但要注意的是，当我在模块中填充选择输入时，使用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)

标签： rshiny

解决方案

改编自我在这里的回答（你需要一个idfor your 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)

推荐阅读