R语言 基于用户界面输入的动态界面/服务器模块

waxmsbnn  于 2023-01-28  发布在  其他
关注(0)|答案(1)|浏览(138)

假设我在4个不同的目录(.“/X1/Y1/"、.”/X1/Y2/"、.“/X2/Y1/"、.”/X2/Y2/”)中有4组UI/服务器模块,我想根据侧边栏中的输入加载所选的组。
我尝试在dashboardBody()中使用source(),但没有成功。

library(shiny)
library(shinydashboard)

# path to modules
in_path <- "C:/a/b/c/"

# ui
ui <- dashboardPage(
  
  dashboardHeader(title = "test"),

  dashboardSidebar(

    br(),
    selectInput('f1', 'Folder 1', choices = c("X1", "X2")),
    helpText(""),
    selectInput('f2', 'Folder 2', choices = c("Y1", "Y2")),
    br(),
    actionButton("load", "Load", icon("thumbs-up"), width = "85%")

  ),

  dashboardBody(
    
    # UI module here from, e.g., "C:/a/b/c/X1/Y2/my_UI.R"
    
  )
)

# server
server <- function(input, output, session) {
  
  # server module here from, e.g., "C:/a/b/c/X1/Y2/my_Server.R"
  
}

shinyApp(ui, server)
wi3ka0sx

wi3ka0sx1#

由于shiny模块是简单的函数,因此我将在开始时提供它们的源代码,并使用uiOutput显示不同的模块。
下面是一个总体思想的工作示例(示例模块代码引以为傲地从官方Shiny documentation中窃取):

<mod1.R>

counterButton <- function(id, label = "Counter") {
   ns <- NS(id)
   tagList(
      actionButton(ns("button"), label = label),
      verbatimTextOutput(ns("out"))
   )
}

counterServer <- function(id) {
   moduleServer(
      id,
      function(input, output, session) {
         count <- reactiveVal(0)
         observeEvent(input$button, {
            count(count() + 1)
         })
         output$out <- renderText({
            count()
         })
         count
      }
   )
}

<mod2.R>

csvFileUI <- function(id, label = "CSV file") {
   ns <- NS(id)
   
   tagList(
      fileInput(ns("file"), label),
      checkboxInput(ns("heading"), "Has heading"),
      selectInput(ns("quote"), "Quote", c(
         "None" = "",
         "Double quote" = "\"",
         "Single quote" = "'"
      ))
   )
}

csvFileServer <- function(id, stringsAsFactors  = TRUE) {
   moduleServer(
      id,
      ## Below is the module function
      function(input, output, session) {
         # The selected file, if any
         userFile <- reactive({
            # If no file is selected, don't do anything
            validate(need(input$file, message = FALSE))
            input$file
         })
         
         # The user's data, parsed into a data frame
         dataframe <- reactive({
            read.csv(userFile()$datapath,
                     header = input$heading,
                     quote = input$quote,
                     stringsAsFactors = stringsAsFactors)
         })
         
         # We can run observers in here if we want to
         observe({
            msg <- sprintf("File %s was uploaded", userFile()$name)
            cat(msg, "\n")
         })
         
         # Return the reactive that yields the data frame
         return(dataframe)
      }
   )    
}

一米四分一秒

library(shiny)

source("mod1.R")
source("mod2.R")

my_mods <- list("Counter Button" = list(ui = counterButton,
                                        server = counterServer),
                "CSV Uploader" = list(ui = csvFileUI ,
                                      server = csvFileServer))

ui <- fluidPage(
   sidebarLayout(
      sidebarPanel(
         selectInput("mod_sel",
                     "Which Module should be loaded?",
                     names(my_mods))
      ),
      mainPanel(
         uiOutput("content"),
         verbatimTextOutput("out")
      )
   )
)

server <- function(input, output) {
   uuid <- 1
   handler <- reactiveVal()
   
   output$content <- renderUI({
      my_mods[[req(input$mod_sel)]]$ui(paste0("mod", uuid))
   })
   
   observeEvent(input$mod_sel, {
      handler(my_mods[[req(input$mod_sel)]]$server(paste0("mod", uuid)))
      uuid <<- uuid + 1
   })
   
   output$out <- renderPrint(req(handler())())
}

shinyApp(ui, server)

一些解释

1.您将模块代码放在mod[12].R中,它是相当直接的。
1.在你的主应用中,你加载了两个(!)源文件,出于管理的原因,我把两个模块函数(uiserver)放在一个list中,但这并不是严格必要的,但有利于未来的扩展。
1.在您的UI中,您有一个uiOutput,它根据选定的模块动态呈现。
1.在您的server中,您放置了动态呈现UI并调用相应服务器函数的代码。

  1. uid结构基本上是用来强制一个新的渲染,无论你何时改变选择。否则,当你回到一个你已经渲染过的模块时,你可能仍然会看到一些旧的值。

相关问题