rshinyshiny-reactivityshinymodulesgooglesheets4

Shiny app with multiple input modules that creates the same output


I have an Shiny app where the users upload data to be processed. The user can choose a data source (like a file or a connection to a cloud service like google sheets). The number of types of data sources will increase in future. My plan was to make a module for every type of data source (local files, cloud services, databases, etc.). The problem is that everything has to go to the same object in output. I cannot seem to get this working with modules. Below is an example that doesn't work.

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()
}

Now make a module that calls the appropriate data-loading modulde depending on the choice of the user

# 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 the approach

# 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))
}

I want the user to be able to choose either a file or a google sheet and the data to be displayed.


Solution

  • Below is a working, but quite modified, version of your application. A few comments:

    1. What you are trying to do with txtnm <- paste0(ifelse(is.null(iid), "", paste0(iid, "-")), "google_txt") and fnn <- paste0(ifelse(is.null(iid), "", paste0(iid, "-")), "fn") is unnecessary - Shiny's namespace functionality handles all of that on your behalf. Consequently, I have removed those lines of code; I have also removed the 'iid' parameters from functions 'read_google_sheets_server' and 'load_all_server', as you do not seem to use the arguments passed to the 'iid' parameters for anything else.

    2. Extracting the namespace in 'read_google_sheets_server' and 'load_all_server' (as you are doing by ns <- session$ns) serves no purpose. It is usually only necessary when you want to use uiOutput/renderUI in your module (e.g. as in your "multi_source" module); I have therefore removed the ns <- session$ns calls from 'read_google_sheets_server' and 'load_all_server'.

    3. I added an actionButton to 'read_google_sheets_ui', identical to the one you had in 'load_all_ui', to prevent code in 'load_all_server' from being executed with every character typed into the textInput.

    4. I renamed "load_all_" to "read_file_" to minimise confusion.

    5. There is generally no need to wrap calls to input$... in a reactive statement if you really just want to extract the value of an input item, because 'input' is inherently reactive. Since we have added an actionButton to 'read_google_sheets_ui' and moved the validate(need(...)) statement there, the code for determining 'chosenURL' can thus be simplified to chosenURL <- input[["google_txt"]]

    6. In module 'load_all_ui' (which I renamed to 'read_file_ui') you forgot to wrap the ID of the actionButton in a call to ns().

    7. Your 'load_all_server' (which I renamed to 'read_file_server') lacked an observeEvent for the actionButton which you put in the module's UI.

    8. Things derailed a bit in module "multi_source" and the code for the ui and server functions of the app itself, so I combined the code for that module with the code for the app (for starters, it seemed like you intended to render either a 'read_google_sheets_ui' or a 'read_file_ui' for uiOutput "multiUI", but the tag lists that you constructed contained neither of those components).

    9. I think it may help you a lot to carefully read through the following article: 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))