rshinyshinymodules

modularized `excelInput()` in shiny


I define a module to import excel. Hoping we can return the data and the name of excel to a global rv.

I observe the read event in console, I put a verbatimTextOutput() in UI, but the passing failed, print() always NULL, the value didn't return to the vectors I want.

Any advice would be greatly appreciated.

excelInput <- function(id) {
  ns <- NS(id)
  tagList(
    div(style = "margin-bottom: -15px;", fileInput(ns("excel"), label = ".csv, or .xlsx", accept = c(".csv", ".xlsx"), multiple = FALSE)),
    uiOutput(ns("sheetUI")),
    uiOutput(ns("readUI"))
  )
}

excelInputServer <- function(id, needRead, data_rv, name_rv = NULL) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    ext <- reactive({tools::file_ext(input$excel$name)})
    output$sheetUI <- renderUI({
      req(ext())
      if (ext() == "xlsx") {
        selectInput(ns("sheet"), "Sheet", choices = readxl::excel_sheets(input$excel$datapath))
      }
    })
    if (needRead == TRUE) {
      output$readUI <- renderUI({
        actionButton(ns("read"), "Read")
      })
      observe({
        shinyjs::toggleState("read", condition = !is.null(input$excel))
      })
      observeEvent(input$read, {
        if (ext() == "csv") {
          data_rv <- readr::read_csv(input$excel$datapath)
          if (!is.null(name_rv)) {
            name_rv <- stringr::str_extract(input$excel$name, ".*(?=\\.)")
          }
        } else if (ext() == "xlsx") {
          data_rv <- readxl::read_xlsx(input$excel$datapath, input$sheet)
          if (!is.null(name_rv)) {
            name_rv <- paste0(stringr::str_extract(input$excel$name, ".*(?=\\.)"), "_#", input$sheet, "#")
          }
        }
      })
    } else {
      observe({
        req(ext())
        if (ext() == "csv") {
          data_rv <- readr::read_csv(input$excel$datapath)
          if (!is.null(name_rv)) {
            name_rv <- stringr::str_extract(input$excel$name, ".*(?=\\.)")
          }
        } else if (ext() == "xlsx") {
          data_rv <- readxl::read_xlsx(input$excel$datapath, input$sheet)
          if (!is.null(name_rv)) {
            name_rv <- paste0(stringr::str_extract(input$excel$name, ".*(?=\\.)"), "_#", input$sheet, "#")
          }
        }
      })
    }
  })
}


library(shiny)
shinyApp(
  ui <- fluidPage(
    shinyjs::useShinyjs(),
    fluidRow(
      column(width = 4, excelInput("needRead")),
      column(width = 8, verbatimTextOutput("print1"))
    ),
    fluidRow(
      column(width = 4, excelInput("noRead")),
      column(width = 8, verbatimTextOutput("print2"))
    )
  ),
  server <- function(input, output, session) {

    rv <- reactiveValues()

    excelInputServer("needRead", TRUE, rv$data_test1, rv$filename_test1)
    output$print1 <- renderPrint({
      print(rv$filename_test1)
      print(rv$data_test1)
    })

    excelInputServer("noRead", FALSE, rv$data_test1)
    output$print2 <- renderPrint({
      print(rv$filename_test2)
      print(rv$data_test2)
    })
  }
)

Solution

  • I think you want something like that. You have to return some objects from the server module.

    library(shiny)
    
    excelInput <- function(id) {
      ns <- NS(id)
      tagList(
        div(style = "margin-bottom: -15px;", fileInput(ns("excel"), label = ".csv, or .xlsx", accept = c(".csv", ".xlsx"), multiple = FALSE)),
        uiOutput(ns("sheetUI")),
        uiOutput(ns("readUI"))
      )
    }
    
    excelInputServer <- function(id, needRead) {
      moduleServer(
        id, 
        function(input, output, session) {
          ns <- session$ns
          
          ext <- eventReactive(
            input$excel, {
              tools::file_ext(input$excel$name)
            })
          
          output$sheetUI <- renderUI({
            req(ext())
            if (ext() == "xlsx") {
              selectInput(ns("sheet"), "Sheet", choices = readxl::excel_sheets(input$excel$datapath))
            }
          })
          
          Data <- reactiveVal()
          Name <- reactiveVal()
          
          if(needRead) {
            output$readUI <- renderUI({
              actionButton(ns("read"), "Read")
            })
            
            observe({
              shinyjs::toggleState("read", condition = !is.null(input$excel))
            })
            
            observeEvent(input$read, {
              if (ext() == "csv") {
                dat <- readr::read_csv(input$excel$datapath)
                Data(dat)
                Name(stringr::str_extract(input$excel$name, ".*(?=\\.)"))
              } else if (ext() == "xlsx") {
                dat <- readxl::read_xlsx(input$excel$datapath, input$sheet)
                Data(dat)
                Name(paste0(stringr::str_extract(input$excel$name, ".*(?=\\.)"), "_#", input$sheet, "#"))
              }
            })
          } else {
            observe({
              req(ext())
              if (ext() == "csv") {
                dat <- readr::read_csv(input$excel$datapath)
                Data(dat)
                Name(stringr::str_extract(input$excel$name, ".*(?=\\.)"))
              } else if (ext() == "xlsx") {
                dat <- readxl::read_xlsx(input$excel$datapath, input$sheet)
                Data(dat)
                Name(paste0(stringr::str_extract(input$excel$name, ".*(?=\\.)"), "_#", input$sheet, "#"))
              }
            })
          }
          return(list(data = Data, name = Name))
        }
      )
    }
    
    
    library(shiny)
    shinyApp(
      ui <- fluidPage(
        shinyjs::useShinyjs(),
        fluidRow(
          column(width = 4, excelInput("needRead")),
          column(width = 8, verbatimTextOutput("print1"))
        ),
        fluidRow(
          column(width = 4, excelInput("noRead")),
          column(width = 8, verbatimTextOutput("print2"))
        )
      ),
      server <- function(input, output, session) {
        
        x1 <- excelInputServer("needRead", TRUE)
        output$print1 <- renderPrint({
          print(x1$data())
          print(x1$name())
        })
        
        x2 <- excelInputServer("noRead", FALSE)
        output$print2 <- renderPrint({
          print(x2$data())
          print(x2$name())
        })
      }
    )