具有创建相同输出的多个输入模块的闪亮应用程序

Question

我有一个闪亮的应用程序，用户可以在其中上传要处理的数据。用户可以选择数据源（如文件或与云服务的连接，如 google sheets）。未来数据源的种类会越来越多。我的计划是为每种类型的数据源（本地文件、云服务、数据库等）制作一个模块。问题是所有内容都必须转到输出中的同一个对象。我似乎无法将其与模块一起使用。下面是一个不起作用的例子。

library(shiny)
library(googlesheets4)

# Google Sheets module
read_google_sheets_ui <- function(id){
  ns <- shiny::NS(id)
  shiny::tagList(
    shiny::textInput(ns("google_txt"), "Enter google identifier:")
  )
}

read_google_sheets_server <- function(input, output, session, rv, iid = NULL){
  ns <- session$ns
  txtnm <- paste0(ifelse(is.null(iid), "", paste0(iid, "-")), "google_txt")
  chosenURL <- reactive({
    validate(need(input[[txtnm]], message = "No URL selected"))
    print("txtnm is:", txtnm)
    input[[txtnm]]
  })

  chosenGS <- reactive({
    ID <- as_sheets_id(chosenURL())
    read_sheet(ID)
  })
  return(chosenGS())
}

# File reading module
load_all_ui <- function(id){
  ns <- NS(id)
  shiny::tagList(
    fileInput(inputId = ns("fn"), label = "Choose your file"),
    actionButton("laai", label = "Load")
  )
}

load_all_server <- function(input, output, session, rv, iid = NULL){
  ns <- session$ns
  fnn <- paste0(ifelse(is.null(iid), "", paste0(iid, "-")), "fn")
  chosenD <- reactive({
    shiny::validate(need(input[[fnn]], message = "No file selected"))
    dp <- as.character(input[[fnn]]$datapath)
    print("\ndp is: ", dp)
    rio::import(file = dp, setclass = "data.frame")
  }, domain = session)
  chosenD()
}

现在制作一个模块，根据用户的选择调用适当的数据加载模块

# Module UI
multi_source_ui <- function(id){
  ns <- NS(id)
  shiny::tagList(
    selectInput(inputId = ns("input_type_select"), 
                label = "Choose data input type", 
                choices = c("File" = "file", 
                            "Cloud" = "cloud")
    ), 
    uiOutput(ns("multiUI"))
  )
}

# Module Server
multi_source_server <- function(input, output, session){
  ns <- session$ns
  filelist <- list(fileInput(inputId = "fn", label = "Choose your file!!!"), 
                   actionButton(inputId = "fn_go", label = "Load file"))
  googlelist <- list(textInput("google_txt", "Enter google identifier:"),
                     actionButton(inputId = "google_go", label = "Load from Google Sheet"))

  output$the_ui <- eventReactive(
    eventExpr = input$input_type_select,
    valueExpr = ifelse(input$input_type_select == "file", 
                       tagList(filelist),
                       tagList(googlelist))
  )
}

multi_source_data <- function(input, output, session, rv, iid ){
  ns <- session$ns
  observeEvent(ns(input$google_txt), { rv$the_data <- callModule(read_google_sheets_server, id = iid, iid = iid)})
  observeEvent(ns(input$fn$datapath),{ rv$the_data <- callModule(load_all_server, id = iid)})
}

测试方法

# Test
multi_source_test <- function(){
  uii <- fluidPage(
    multi_source_ui("id1"), 
    uiOutput("multiUI"),
    h2("The data"),
    tableOutput("multidata")
  )

  serverr <- function(input, output, session){
    the_ui <- callModule(multi_source_server, "id1")
    the_data <- callModule(module = multi_source_data, id = "id2", rv = rv, iid = "id1")
    # outputs
    output$multiUI <- renderUI({ the_ui() })
    output$multidata <- renderTable({ the_data() })
  }

  shinyApp(uii, serverr, options =list(test.mode = TRUE))
}

我希望用户能够选择文件或 google sheet 以及要显示的数据。

Answer 1

以下是您的应用程序的工作版本，但 quite 已修改。几点评论：

你试图用 txtnm <- paste0(ifelse(is.null(iid), "", paste0(iid, "-")), "google_txt") 和 fnn <- paste0(ifelse(is.null(iid), "", paste0(iid, "-")), "fn") 做什么是不必要的 - Shiny 的命名空间功能会代表你处理所有这些。因此，我删除了这些代码行；我还从函数 'read_google_sheets_server' 和 'load_all_server' 中删除了 'iid' 参数，因为您似乎没有将传递给 'iid' 参数的参数用于其他任何事情。
提取 'read_google_sheets_server' 和 'load_all_server' 中的名称空间（正如您在 ns <- session$ns 中所做的那样）毫无用处。通常只有当你想在你的模块中使用 uiOutput/renderUI 时才需要（例如在你的 "multi_source" 模块中）；因此，我从 'read_google_sheets_server' 和 'load_all_server'.

ns <- session$ns

我向 'read_google_sheets_ui' 添加了一个 actionButton，与 'load_all_ui' 中的相同，以防止 'load_all_server' 中的代码在输入每个字符时执行进入 textInput.
我将 "load_all_" 重命名为 "read_file_" 以尽量减少混淆。
如果你真的只是想提取输入项的值，通常不需要在反应式语句中包装对 input$... 的调用，因为 'input' 本质上是反应性的。由于我们在 'read_google_sheets_ui' 中添加了一个 actionButton 并将 validate(need(...)) 语句移动到那里，因此确定 'chosenURL' 的代码可以简化为 chosenURL <- input[["google_txt"]]
在模块 'load_all_ui'（我将其重命名为 'read_file_ui'）中，您忘记将 actionButton 的 ID 包装在对 ns() 的调用中。
您的 'load_all_server'（我将其重命名为 'read_file_server'）缺少您放入模块 UI.
中的 actionButton 的 observeEvent
模块 "multi_source" 和应用程序本身的 ui 和服务器功能的代码有点出轨，所以我将该模块的代码与代码结合起来对于应用程序（对于初学者来说，您似乎打算为 ui 输出 "multiUI" 呈现 'read_google_sheets_ui' 或 'read_file_ui'，但您构建的标签列表既不包含这些组件）。
我认为仔细阅读以下文章可能对您有很大帮助：https://shiny.rstudio.com/articles/modules.html

library(shiny)
library(googlesheets4)

read_google_sheets_ui <- function(id){
    ns <- NS(id)
    tagList(
        textInput(ns("google_txt"), "Enter google identifier:"),
        actionButton(ns("laai"), label = "Load")
    )
}

read_google_sheets_server <- function(input, output, session){

    chosenGS <- reactiveVal()

    observeEvent(input$laai, {
        validate(need(input[["google_txt"]], message = "No URL selected"))
        chosenURL <- input[["google_txt"]]
        ID <- as_sheets_id(chosenURL)
        chosenGS(read_sheet(ID))
        #chosenGS(data.frame(stringsAsFactors = FALSE, x = c(1:4), y = 5:8))
    })

    return(chosenGS)
}

read_file_ui <- function(id){
    ns <- NS(id)
    shiny::tagList(
        fileInput(inputId = ns("fn"), label = "Choose your file"),
        actionButton(inputId = ns("laai"), label = "Load")
    )
}

read_file_server <- function(input, output, session){

    chosenD <- reactiveVal()

    observeEvent(input$laai, {
        validate(need(input[["fn"]], message = "No file selected"))
        dp <- as.character(input[["fn"]]$datapath)
        chosenD(rio::import(file = dp, setclass = "data.frame"))
    })

    return(chosenD)
}

uii <- fluidPage(

    selectInput(inputId = "input_type_select", 
                label = "Choose data input type", 
                choices = c("File" = "file", 
                            "Cloud" = "cloud")), 
    uiOutput("multiUI"),

    h2("The data"),
    tableOutput("multidata")
)

serverr <- function(input, output, session){

    theData <- reactiveVal(NULL)

    output$multiUI <- renderUI({

        switch(input$input_type_select,
               file = read_file_ui(id = "readFile_ui"),
               cloud = read_google_sheets_ui(id = "readGS_ui"))
    })

    observeEvent(input$input_type_select, {
        theData(switch(input$input_type_select,
                       file = callModule(read_file_server, id = "readFile_ui"),
                       cloud = callModule(read_google_sheets_server, id = "readGS_ui")))
    })

    output$multidata <- renderTable({ theData()() })
}

shinyApp(uii, serverr, options = list(test.mode = TRUE))

具有创建相同输出的多个输入模块的闪亮应用程序

Shiny app with multiple input modules that creates the same output

r

shiny

shiny-reactivity

shinymodules

googlesheets4