Блестящее приложение с несколькими модулями ввода, которое создает одинаковый вывод - PullRequest
Новая
       35

Блестящее приложение с несколькими модулями ввода, которое создает одинаковый вывод

0 голосов
/ 10 мая 2019

У меня есть приложение 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, и данные для отображения.

...