【问题标题】：pass renderUI input from one Shiny module to another将 renderUI 输入从一个 Shiny 模块传递到另一个
【发布时间】：2017-08-19 17:19:00
【问题描述】：

我正在尝试模块化 Shiny 代码，用于将 CSV 文件作为输入上传到 scatterD3 绘图中。额外的 UI 控件将从 renderUI 更改 x 变量和 y 变量。这只是来自How to organize large R Shiny apps? 的 Mikael Jumppanen 回答的一个小修改，但我一直在努力，无法让最后一点工作。

对于这个数据集，我使用的是 mtcars 数据集https://gallery.shinyapps.io/066-upload-file/_w_469e9927/mtcars.csv

## load libraries
library(shiny)
library(stringr)
library(scatterD3)

#source("/Users/echang/scratch/tmp/MSD_D3scatter/csvFile_Module.R")
csvFileInput <- function(id, label="CSV file") {
  ## Create namespace
  ns<-NS(id)
  tagList(
    uiOutput(ns("controls"))
  )
}

csvFileControl <- function(id){
  ns <- NS(id)
  tagList(
    column(width=3, uiOutput(ns("ColName"))),
    column(width=3, uiOutput(ns("ColEntry")))
  )
}

csvFileUI <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("csvTable"))
  )
}

## server module
csvFile <- function(input, output, session, stringsAsFactors) {
  ns <- session$ns
  ## to reuse namespace, session must be first!!!

  ## User selected file
  userFile <- reactive({
    # If no file is selected, don't do anything
    validate(need(input$file, message = FALSE))
    input$file
  })

  dataframe <- reactive({
    read.csv(
      userFile()$datapath,
      header = input$header,
      sep=input$sep,
      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")
  })

  output$controls <- renderUI({
    ## use taglist to keep everything together
    tagList(
      fileInput(ns('file'), 'Choose CSV file', 
                accept=c('txt/csv','text/comma-separated-values,text/plain','.csv')),
      checkboxInput(ns('header'), 'Has heading', TRUE),
      radioButtons(ns('sep'),'Separator', c(Comma=',',Semicolon=';',Tab='\t'), ','),
      selectInput(ns('quote'),'Quote', c(None ='','Double Quote'='"','Single Quote'="'"),'"')
    )
  })

  ## use renderUI to display table
  output$csvTable <- renderUI({
    output$table <- renderDataTable(dataframe())
    dataTableOutput(ns("table"))
  })

  ## Column Name
  output$ColName <- renderUI({
    df <- dataframe()
    if (is.null(df)) return(NULL)
    items=names(df)
    names(items)=items
    tagList(
      selectInput(ns("xvar"), "Column Names", items),
      selectInput(ns("yvar"), "Column Names", items)
    )
  })

  ## Column Entry
  output$ColEntry <- renderUI({
    df <- dataframe()
    if (is.null(input$col)) return(NULL)
    tagList(
      selectInput(ns("entry"), "Entry Names", df[,input$xvar])
    )
  })

  # Return the reactive that yields the data frame
  return(dataframe)

}## End of module


## scatterD3 module -------------------------------------------------------------

D3scatterUI <- function(id){
  ns<-NS(id)
  tagList(
    scatterD3Output(ns("scatterplot1"))
    )
}

D3scatter <- function(input,output,session,data,xvar,yvar){
  ns <- session$ns

  output$scatterplot1 <- renderScatterD3({
    #scatterD3(data = data, x=mpg, y=carb,
    scatterD3(data = data, x=xvar, y=yvar,
              labels_size= 9, point_opacity = 1,
              #col_var=cyl, symbol_var= data$Assay,
              #lab= paste(mpg, carb, sep="|") , lasso=TRUE,
              #xlab= "IFN-γ", ylab= "IL-10",
              #click_callback = "function(id, index) {
              #  alert('scatterplot ID: ' + id + ' - Point index: ' + index) 
              #  }", 
              transitions= T)
  })
}


## Shiny ######################################################################
ui <- fluidPage(
  titlePanel("Upload"),

  tabsetPanel(type="tabs",
    tabPanel("tab1",
      sidebarLayout(
        sidebarPanel(csvFileInput("basic")),
        mainPanel(csvFileUI("basic"))
        )
      ),
    tabPanel("tab2",
      tagList(
        fluidRow(csvFileControl("basic")),
        fluidRow(D3scatterUI("first"))
        )
      )
    )
)

server <- function(input, output, session) {
  ## Option 1. CSV uploaded file
  datafile <- callModule(csvFile, "basic", stringsAsFactors = FALSE) 

  ## Option 2. mtcar data loaded at start
  #datafile <- reactive({mtcars}) ## data loaded at runApp()
  #callModule(csvFile, "basic") 

  xvar <- reactive(input$xvar) 
  yvar <- reactive(input$yvar)

  callModule(D3scatter, "first", datafile(), xvar, yvar)

}

shinyApp(ui, server)

我也咨询了https://itsalocke.com/shiny-module-design-patterns-pass-module-input-to-other-modules/的Shiny模块设计

我观看了网络研讨会，但无法在脑海中正确理解逻辑。 https://www.rstudio.com/resources/webinars/understanding-shiny-modules/ 任何帮助将不胜感激！

【问题讨论】：

你的问题到底是什么？
问题很清楚，为什么即使他已经按照描述的方式进行了模块设计，它也不起作用。还没有多少人这样做，因此没有很多代码示例说明如何做到这一点。
对不起！当我发布这个问题时，我有点慌张。要求是在重构代码方面获得帮助，以便 scatterD3plot 将响应更改 xvar 和 yvar

标签： r module shiny

【解决方案1】：

好的，这确实有点困难，因为使用模块并不是很简单。您已经接近了...您的主要问题是没有将所有的反应器打包到一个列表中并将它们传递到需要它们的地方。

我做了以下更改：

csvFile：在csvFile 服务器模块函数中声明了额外的反应函数xvar 和yvar，类似于你已经为dataframe 所做的。
csvFile：将所有需要的反应器打包为一个列表，并将其作为返回值返回，如您帖子中的设计模式链接中所述。（谢谢斯蒂芬洛克）。
server：在callModule(D3scatter,... ) 中传递该列表，再次如该链接中所述。
D3scatter：通过调用scatterD3 进行了一些重构，以使用从指定数据帧中提取的向量。这是因为我无法让它将字符串用作列说明符（但肯定有某种方法）。

以下是上面更改的代码部分：

csv文件服务器模块

csvFile <- function(input, output, session, stringsAsFactors) {
  ns <- session$ns
  ## to reuse namespace, session must be first!!!

  ## User selected file
  userFile <- reactive({
    # If no file is selected, don't do anything
    validate(need(input$file, message = FALSE))
    input$file
  })

  dataframe <- reactive({
    read.csv(
      userFile()$datapath,
      header = input$header,
      sep=input$sep,
      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")
  })

  xvar <- reactive({input[[ "xvar" ]] })
  yvar <- reactive({input[[ "yvar" ]] })

  output$controls <- renderUI({
    ## use taglist to keep everything together
    tagList(
      fileInput(ns('file'), 'Choose CSV file', 
                accept=c('txt/csv','text/comma-separated-values,text/plain','.csv')),
      checkboxInput(ns('header'), 'Has heading', TRUE),
      radioButtons(ns('sep'),'Separator', c(Comma=',',Semicolon=';',Tab='\t'), ','),
      selectInput(ns('quote'),'Quote', c(None ='','Double Quote'='"','Single Quote'="'"),'"')
    )
  })

  ## use renderUI to display table
  output$csvTable <- renderUI({
    output$table <- renderDataTable(dataframe())
    dataTableOutput(ns("table"))
  })

  ## Column Name
  output$ColName <- renderUI({
    df <- dataframe()
    if (is.null(df)) return(NULL)
    items=names(df)
    print(items)
    names(items)=items
    tagList(
      selectInput(ns("xvar"), "Column Names", items),
      selectInput(ns("yvar"), "Column Names", items)
    )
  })

  ## Column Entry
  output$ColEntry <- renderUI({
    df <- dataframe()
    if (is.null(input$col)) return(NULL)
    tagList(
      selectInput(ns("entry"), "Entry Names", df[,input$xvar])
    )
  })

  rlist <- list(dataframe=dataframe,xvar=xvar,yvar=yvar)
  # Return the reactive that yields the data frame
  return(rlist)

}## End of module

服务器

server <- function(input, output, session) {
  ## Option 1. CSV uploaded file
  rlist <- callModule(csvFile, "basic", stringsAsFactors = FALSE) 

  ## Option 2. mtcar data loaded at start
  #datafile <- reactive({mtcars}) ## data loaded at runApp()
  #callModule(csvFile, "basic") 

  callModule(D3scatter, "first", rlist)

}

D3scatter

D3scatter <- function(input,output,session,rlist){
  ns <- session$ns

  output$scatterplot1 <- renderScatterD3({
    #scatterD3(data = data, x=mpg, y=carb,
    mtdf <- rlist$dataframe()
    x <- mtdf[[rlist$xvar()]]
    y <- mtdf[[rlist$yvar()]]
    scatterD3(x=x,y=y,
              labels_size= 9, point_opacity = 1,
              #col_var=cyl, symbol_var= data$Assay,
              #lab= paste(mpg, carb, sep="|") , lasso=TRUE,
              #xlab= "IFN-γ", ylab= "IL-10",
              #click_callback = "function(id, index) {
              #  alert('scatterplot ID: ' + id + ' - Point index: ' + index) 
              #  }", 
              transitions= T)
  })
}

然后它起作用了：

这是所有正在运行的代码，以防我忘记了某处的更改，或者有人只想运行它。顺便说一句，散点图从一个情节变为另一个情节的方式非常酷……它以类似动画的效果连续变形。不寻常。

一个文件中的整个应用程序

## load libraries
library(shiny)
library(stringr)
library(scatterD3)

#source("/Users/echang/scratch/tmp/MSD_D3scatter/csvFile_Module.R")
csvFileInput <- function(id, label="CSV file") {
  ## Create namespace
  ns<-NS(id)
  tagList(
    uiOutput(ns("controls"))
  )
}

csvFileControl <- function(id){
  ns <- NS(id)
  tagList(
    column(width=3, uiOutput(ns("ColName"))),
    column(width=3, uiOutput(ns("ColEntry")))
  )
}

csvFileUI <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("csvTable"))
  )
}

## server module
csvFile <- function(input, output, session, stringsAsFactors) {
  ns <- session$ns
  ## to reuse namespace, session must be first!!!

  ## User selected file
  userFile <- reactive({
    # If no file is selected, don't do anything
    validate(need(input$file, message = FALSE))
    input$file
  })

  dataframe <- reactive({
    read.csv(
      userFile()$datapath,
      header = input$header,
      sep=input$sep,
      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")
  })

  xvar <- reactive({input[[ "xvar" ]] })
  yvar <- reactive({input[[ "yvar" ]] })

  output$controls <- renderUI({
    ## use taglist to keep everything together
    tagList(
      fileInput(ns('file'), 'Choose CSV file', 
                accept=c('txt/csv','text/comma-separated-values,text/plain','.csv')),
      checkboxInput(ns('header'), 'Has heading', TRUE),
      radioButtons(ns('sep'),'Separator', c(Comma=',',Semicolon=';',Tab='\t'), ','),
      selectInput(ns('quote'),'Quote', c(None ='','Double Quote'='"','Single Quote'="'"),'"')
    )
  })

  ## use renderUI to display table
  output$csvTable <- renderUI({
    output$table <- renderDataTable(dataframe())
    dataTableOutput(ns("table"))
  })

  ## Column Name
  output$ColName <- renderUI({
    df <- dataframe()
    if (is.null(df)) return(NULL)
    items=names(df)
    print(items)
    names(items)=items
    tagList(
      selectInput(ns("xvar"), "Column Names", items),
      selectInput(ns("yvar"), "Column Names", items)
    )
  })

  ## Column Entry
  output$ColEntry <- renderUI({
    df <- dataframe()
    if (is.null(input$col)) return(NULL)
    tagList(
      selectInput(ns("entry"), "Entry Names", df[,input$xvar])
    )
  })

  rlist <- list(dataframe=dataframe,xvar=xvar,yvar=yvar)
  # Return the reactive that yields the data frame
  return(rlist)

}## End of module


## scatterD3 module -------------------------------------------------------------

D3scatterUI <- function(id){
  ns<-NS(id)
  tagList(
    scatterD3Output(ns("scatterplot1"))
  )
}

D3scatter <- function(input,output,session,rlist){
  ns <- session$ns

  output$scatterplot1 <- renderScatterD3({
    #scatterD3(data = data, x=mpg, y=carb,
    mtdf <- rlist$dataframe()
    x <- mtdf[[rlist$xvar()]]
    y <- mtdf[[rlist$yvar()]]
    scatterD3(x=x,y=y,
              labels_size= 9, point_opacity = 1,
              #col_var=cyl, symbol_var= data$Assay,
              #lab= paste(mpg, carb, sep="|") , lasso=TRUE,
              #xlab= "IFN-γ", ylab= "IL-10",
              #click_callback = "function(id, index) {
              #  alert('scatterplot ID: ' + id + ' - Point index: ' + index) 
              #  }", 
              transitions= T)
  })
}


## Shiny ######################################################################
ui <- fluidPage(
  titlePanel("Upload"),

  tabsetPanel(type="tabs",
              tabPanel("tab1",
                       sidebarLayout(
                         sidebarPanel(csvFileInput("basic")),
                         mainPanel(csvFileUI("basic"))
                       )
              ),
              tabPanel("tab2",
                       tagList(
                         fluidRow(csvFileControl("basic")),
                         fluidRow(D3scatterUI("first"))
                       )
              )
  )
)

server <- function(input, output, session) {
  ## Option 1. CSV uploaded file
  rlist <- callModule(csvFile, "basic", stringsAsFactors = FALSE) 

  ## Option 2. mtcar data loaded at start
  #datafile <- reactive({mtcars}) ## data loaded at runApp()
  #callModule(csvFile, "basic") 

  callModule(D3scatter, "first", rlist)

}

shinyApp(ui, server)

【讨论】：

感谢您对编辑的如此清晰的剖析！通过将xvar 和yvar 设为响应式，然后将它们返回到列表中，这很好地反映了斯蒂芬·洛克对as.data.frame(reactiveValuesToList(input)) 的使用。这很有教育意义