csvFile服务器模块

Question

我正在尝试模块化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/我们将非常感谢任何帮助!!

Answer 1

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

我做了以下更改：

csvFile：在xvar服务器模块功能中声明了额外的反应函数yvar和csvFile，类似于您已为dataframe所做的事情。
csvFile：将所有需要的被动装置作为列表打包并将其作为返回值返回，如帖子中的设计模式链接所述。（谢谢Steph Locke）。
server：再次按照callModule(D3scatter,... )向下传递该列表，如该链接中所述。
D3scatter：通过调用scatterD3来重构，以使用从指定数据帧中提取的向量。这是因为我无法使用字符串作为列说明符（但肯定有某种方式）。

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

csvFile服务器模块

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)

将一个Shiny模块的renderUI输入传递给另一个模块

1 个答案:

csvFile服务器模块

服务器

D3scatter

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