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

时间：2019-05-10 07:05:07

标签： r module shiny shiny-reactivity shinymodules

我有一个Shiny应用程序，用户可以在其中上传要处理的数据。用户可以选择数据源（例如文件或与Google表格等云服务的连接）。数据源的类型数量将来会增加。我的计划是为每种类型的数据源（本地文件，云服务，数据库等）创建一个模块。问题在于，一切都必须转到输出中的同一对象。我似乎无法使它与模块一起使用。下面是一个不起作用的示例。

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工作表以及要显示的数据。

1 个答案:

答案 0 :(得分：1)

以下是您的应用程序的正常工作版本，但经过了相当多的修改。一些评论：

  1. 您要使用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”参数的参数用于其他任何用途。

  2. 提取“ read_google_sheets_server”和“ load_all_server”中的名称空间（就像您使用ns <- session$ns所做的那样）没有任何作用。通常只有在您想在模块中使用uiOutput / renderUI时才需要（例如，在“ multi_source”模块中）；因此，我从“ read_google_sheets_server”和“ load_all_server”中删除了ns <- session$ns个调用。

  3. 我在'read_google_sheets_ui'中添加了一个actionButton，该按钮与您在'load_all_ui'中使用的按钮相同，以防止'load_all_server'中的代码在textInput中键入的每个字符都被执行。

  4. 我将“ load_all_”重命名为“ read_file_”，以最大程度地减少混乱。

  5. 如果您真的只想提取输入项的值，则通常无需将对input $ ...的调用包装在反应式语句中，因为'input'本质上是反应式的。由于我们已经在'read_google_sheets_ui'中添加了一个actionButton并将validate(need(...))语句移到那里，因此用于确定'chosenURL'的代码可以简化为chosenURL <- input[["google_txt"]]

  6. 在模块“ load_all_ui”（我将其重命名为“ read_file_ui”）中，您忘了在对ns（）的调用中包装actionButton的ID。

  7. 您的“ load_all_server”（我重命名为“ read_file_server”）缺少用于放置在模块UI中的actionButton的watchEvent。

  8. “ multi_source”模块中的内容以及应用程序本身的ui和服务器功能的代码出了些问题，因此我将该模块的代码与应用程序的代码进行了合并（对于初学者而言，您打算为uiOutput“ multiUI”呈现一个'read_google_sheets_ui'或一个'read_file_ui'，但是您构建的标签列表均不包含这些组件。

  9. 我认为仔细阅读以下文章可能会对您有很大帮助：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))
相关问题
最新问题