首页 > 解决方案 > 如何使用 shinydashboard 组合多个 R 模块(带有子模型和 uiOuput)?

问题描述

我正在模块化使用 Shinydashboard 包开发的 Shiny 应用程序。尽管它传统上在我不涉及模块的情况下使用它时有效,但当我尝试将它划分为模块和子模块时,我无法让它工作。在这里,我想组合两个 UI(一个用于侧边栏,一个用于正文),以便从侧边栏上传数据集并将其显示到正文中。如果有人可以为此提供一些帮助,我将非常高兴。

这是通用 Shiny 应用程序的代码:

library(shiny)
library(excelR)
library(vroom)
library(readxl)
library(janitor)
library(dplyr)
library(shinydashboard)
library(shinydashboardPlus)

# # load separate module and function scripts
source("modules.R")

# app_ui 
app_ui <- function() {
  tagList(
    shinydashboardPlus::dashboardPagePlus(
      header = shinydashboardPlus::dashboardHeaderPlus(title = "module_test",
                                                       enable_rightsidebar = FALSE),
      sidebar = shinydashboard::dashboardSidebar(
        shinydashboard::sidebarMenu(id = "tabs",
                                    import_sidebar_ui("import"))
      ),
      body =  shinydashboard::dashboardBody(shinydashboard::tabItems(
        import_body_ui("import"))
      ),
      rightsidebar = NULL,
      title = "Module App"
    )
  )
}
# app_server 
app_server <- function(input, output, session) {
  shiny::moduleServer(id = "import", module = import_server)
}


####################################################################
run_app <- function(...) {
  shiny::shinyApp(
    ui = app_ui, 
    server = app_server)
}
#---------------------------------
run_app()

这是我编写的 modules.R 文件,其中包含侧边栏和正文的 UI,以及服务器:

# Import module ####
# 
# Import sidebar UI
import_sidebar_ui <- function(id) {
  ns <- NS(id)
  shinydashboard::menuItem("Module Testing",
                           tabName = "tab_testing_mod",
                           icon = icon("th"),
                           tagList(
                             selectInput(ns("input_type"),
                                         "Type of file:",
                                         choices = c("Choose one" = "",".csv" = "csv",
                                                     ".txt" = "txt", ".xls/.xlsx" = "xlsx"),
                                         selected = NULL),
                             uiOutput(ns("inputControls")),
                             fileInput(ns("file"), "Data", buttonLabel = "Upload..."),
                             checkboxInput(ns("rownames"), "Check if 1st column contains rownames"),
                             checkboxInput(ns("constant"), "Remove constant columns?"),
                             checkboxInput(ns("empty"), "Remove empty cols?"),
                             actionButton(ns("bttn_import"), "Import data")
                           )
  )
}

# Import body UI
import_body_ui <- function(id) {
  ns <- NS(id)
  shinydashboard::tabItem(tabName = "tab_testing_mod",
                          fluidRow(
                            h3("Imported Data"),
                            excelR::excelOutput(ns("preview")))
                          )
}

# Import server
import_server <- function(input, output, session) {
  ns <- session$ns

  output$inputControls <- renderUI({
    tagList(

      switch(input$input_type,
             "csv" = textInput("delim", "Delimiter (leave blank to guess)", ""),
             "txt" = textInput("delim", "Delimiter (leave blank to guess)", "")
      ),
      switch(input$input_type,
             "xlsx" = numericInput("sheet", "Sheet number", value = 1))
    )
  })

  raw <- reactive({
    req(input$file)

    if (input$input_type == "csv" || input$input_type == "txt") {
      delim <- if (input$delim == "") NULL else input$delim
      data <- vroom::vroom(input$file$datapath, delim = delim)
    } else if (input$input_type == "xlsx") {
      data <- tibble::as.tibble(readxl::read_excel(input$file$datapath, sheet = input$sheet, col_names = TRUE))
    } else {
      return(NULL)
    }
    raw <- data
    raw
  })

  tidied <- eventReactive(input$bttn_import,{
    out <- raw()
    if (input$empty) {
      out <- janitor::remove_empty(out, "cols")
    }
    if (input$constant) {
      out <- janitor::remove_constant(out)
    }
    if (input$rownames) {
      out <- tibble::column_to_rownames(out, var = colnames(out[1]))
    }

    out <- out %>% dplyr::mutate_if(is.character,as.factor)

    out
  })

  output$preview <- excelR::renderExcel({
    excelR::excelTable(data = raw(),
                       colHeaders = toupper(colnames(raw())), 
                       fullscreen = FALSE,  
                       columnDrag = TRUE,  
                       rowDrag = TRUE,
                       wordWrap = FALSE,
                       search =TRUE,
                       showToolbar = TRUE,
                       minDimensions = c(ncol(raw()),10)
  )
  })
}

在我看来,我可以上传数据集(.csv、.txt 或 .xlsx)文件,但无法将其显示到正文中。如果您能帮助我,我将非常高兴,非常感谢您的帮助。

标签: rshinymoduleshinydashboardshinymodules

解决方案


推荐阅读