将 renderUI 输入从一个 Shiny 模块传递到另一个 [英] pass renderUI input from one Shiny module to another

查看：49
本文介绍了将 renderUI 输入从一个 Shiny 模块传递到另一个的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在尝试模块化 Shiny 代码，以便将 CSV 文件作为输入上传到 scatterD3 图中.额外的 UI 控件将来自 renderUI 以更改 x 变量和 y 变量.这只是来自

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

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

## 加载库图书馆(闪亮)图书馆(字符串)图书馆(scatterD3)#source("/Users/echang/scratch/tmp/MSD_D3scatter/csvFile_Module.R")csvFileInput <- function(id, label="CSV file") {## 创建命名空间ns<-NS(id)标签列表(uiOutput(ns("控件")))}csvFileControl <- 函数(id){ns <- NS(id)标签列表(列(宽度= 3，uiOutput(ns(ColName")))，列(宽度= 3，uiOutput(ns(ColEntry"))))}csvFileUI <- 函数(id){ns <- NS(id)标签列表(uiOutput(ns("csvTable")))}##服务器模块csvFile <- 函数(输入、输出、会话、stringsAsFactors){ns <- 会话$ns##要重用命名空间，会话必须是第一位的！！！## 用户选择的文件用户文件 <- 反应式({# 如果没有文件被选中，什么都不做验证(需要(输入 $ 文件，消息 = FALSE))输入$文件})数据框 <- 反应式({读取.csv(userFile()$datapath,标头 = 输入$标头，sep=输入$sep，报价=输入$报价，stringsAsFactors = stringsAsFactors)})# 如果我们愿意，我们可以在这里运行观察者观察({msg <- sprintf("文件 %s 已上传", userFile()$name)猫(味精，\n")})xvar <-reactive({input[["xvar" ]] })yvar <-reactive({input[["yvar" ]] })output$controls <- renderUI({## 使用 taglist 把所有东西放在一起标签列表(fileInput(ns('file'), '选择 CSV 文件',accept=c('txt/csv','text/comma-separated-values,text/plain','.csv')),checkboxInput(ns('header'), '有标题', TRUE),radioButtons(ns('sep'),'Separator', c(Comma=',',Semicolon=';',Tab='\t'), ','),selectInput(ns('quote'),'Quote', c(None='','双引号'='"','单引号'="'"),'"'))})##使用renderUI显示表格output$csvTable <- renderUI({output$table <- renderDataTable(dataframe())数据表输出(ns(表"))})## 列名output$ColName <- renderUI({df <- 数据帧()如果(is.null(df))返回(NULL)项目=名称(df)打印(项目)名称(项目)=项目标签列表(selectInput(ns("xvar"), "列名", items),选择输入(ns(yvar")，列名"，项目))})## 列条目output$ColEntry <- renderUI({df <- 数据帧()if (is.null(input$col)) 返回(NULL)标签列表(selectInput(ns("entry"), "条目名称", df[,input$xvar]))})rlist <- 列表(数据帧=数据帧，xvar=xvar，yvar=yvar)# 返回产生数据帧的反应式返回(列表)}##模块结束## scatterD3 模块-------------------------------------------------------------D3scatterUI <- function(id){ns<-NS(id)标签列表(scatterD3Output(ns("scatterplot1")))}D3scatter <- 函数(输入，输出，会话，rlist){ns <- 会话$nsoutput$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,标签大小= 9，点不透明度= 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('散点图 ID: ' + id + ' - 点索引: ' + index)# }",转换 = T)})}## 闪亮的 ######################################################################ui <-流体页面(标题面板(上传")，tabsetPanel(type="tabs",tabPanel("tab1",侧边栏布局(sidebarPanel(csvFileInput("basic")),主面板(csvFileUI(基本")))),tabPanel("tab2",标签列表(流体行(csvFileControl(基本"))，流体行(D3scatterUI(第一"))))))服务器 <- 功能(输入，输出，会话){## 选项 1. CSV 上传文件rlist <- callModule(csvFile, "basic", stringsAsFactors = FALSE)## 选项 2. 启动时加载 mtcar 数据#datafile <-reactive({mtcars}) ## 在 runApp() 加载的数据#callModule(csvFile，基本")callModule(D3scatter, "first", rlist)}闪亮应用程序(用户界面，服务器)

I am trying to modularize Shiny code, for uploading CSV file as input into scatterD3 plot. Additional UI control will be from renderUI to change the x-variable and y-variable. It is just a small modification from the Mikael Jumppanen answer from How to organize large R Shiny apps?, but I've struggling and cannot get this last bit to work.

For this dataset, I am using the mtcars dataset 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)

I also consulted the Shiny module design from https://itsalocke.com/shiny-module-design-patterns-pass-module-input-to-other-modules/

I watched the webinar but am unable to get the logic right in my head. https://www.rstudio.com/resources/webinars/understanding-shiny-modules/ Any help will be greatly appreciated!!

解决方案

Okay, this was indeed a bit difficult, as working with modules is not exactly straightforward. You were close... your main problem was not packing up all of the reactives in a list and passing them to where they were needed.

I made the following changes:

  1. csvFile: declared additional reactive functions xvar and yvar in the csvFile server module function similarly to what you had already done for dataframe.
  2. csvFile: packed all the needed reactives up as a list and returned it as the return value as described in the design pattern link in your post. (Thank you Steph Locke).
  3. server: passed that list down in the callModule(D3scatter,... ), again as described in that link.
  4. D3scatter: refactored a bit by making the call to scatterD3 to use vectors extracted from the specified dataframe. This is because I couldn't get it to work with strings as column specifiers (but there is surely a way somehow).

Here are the changed code parts from above:

csvFile 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

server

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

Then it worked:

Here is all the running code again, in case I forgot a change somewhere, or someone just wants to run it. As an aside it is quite cool the way the scatter plot changes from one plot to another... it morphs continuously with an animation-like effect. Unusual.

Entire application in one file

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

这篇关于将 renderUI 输入从一个 Shiny 模块传递到另一个的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
其他开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆