R Shiny 中具有反应数据的绘图的动态数量

Question

I am trying to make an RShiny app that you can pick a gene from a list, and it will display different graphs using that gene's transcripts. However, each gene has a different number of transcripts, so a different number of graphs must be displayed every time a different gene is chosen. How I have it set right now is that when a person chooses a gene, a new table is created with the transcript numbers (data to be plotted) along with a new list of all the transcript names (length of this list is the amount of plots that I need). These are reactive values.

Below, in the server, I made a function that creates the graph that I want, and then I iterate through the creation of the function by indexing into the reactive list of names, so it creates a graph for each name (as each name is a different transcript). Right now, the code iterates through all the names correctly but only displays the last plot. Is there a way to have every plot displayed? I have tried a lot of different things, from renderUI to using local calls, but cannot figure it out.

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
    selectInput("var", label = "Choose a gene to display", names),
        mainPanel(
       plotOutput("tdot"))
))


server <- function(input, output) {
genename <- reactive({
    input$var
})

transTable2 <- reactive ({
    cbind(biofluids, select(transTable, starts_with(input$var)))
})

names <- reactive ({
    tableBF <- cbind(biofluids, select(transTable, starts_with(input$var)))
    n <- colnames(tableBF)
    final <- n[-1]
})



createUI <- function(name, table) {
    ggplot(table, aes_string(x = "biofluids", y = name))+geom_boxplot(aes(color = biofluids))+
        geom_boxplot(aes(fill = biofluids)) + scale_y_log10()+ylab( 'log10 normalized counts')+
        ggtitle(name)}

output$tdot <- renderPlot({
        lapply(1:length(names()), function(i) 
        createUI(names()[i], transTable2()))
})

}

# Run the application 
shinyApp(ui = ui, server = server)

A reproducible example is as follows with the iris dataset, which would have the user select a category (either "Sepal" or "Petal"), and then create a plot for every column in the dataset that starts with that word:

cats <- c("Sepal", "Petal")
ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
    selectInput("var", label = "Choose a category to display", cats),
        mainPanel(
       plotOutput("tdot"))
))


server <- function(input, output) {
category <- reactive({
    input$var
})

iris2 <- reactive ({
     select(iris, starts_with(input$var))
})

names <- reactive ({
    table2 <- select(transTable, starts_with(input$var))
    n <- colnames(table2)
})



createUI <- function(name, table) {
    ggplot(table, aes_string(x = "species", y = name))+geom_boxplot(aes(color = species))+
        geom_boxplot(aes(fill = species)) + scale_y_log10()+ylab( 'log10 normalized counts')+
        ggtitle(name)}

output$tdot <- renderPlot({
        lapply(1:length(names()), function(i) 
        createUI(names()[i], iris2()))
})

}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

The following code generates dynamic number of outputs with iris data. You should be able to adapt this to your data.

  library(shiny)
  library(tidyverse)

  # Load data
  data("iris")

  # Add row id
  iris2 <- iris %>% mutate(ID = 1:n())

  # ui
  ui <- fluidPage(
    sidebarPanel(
      selectInput(inputId = "sel", label = "Select one or more parameters",
                  choices = names(iris2), multiple = TRUE)
    ),
    mainPanel(
      uiOutput("plots")
    )
  )

  # server
  server <- function(input, output, session){

    # Dynamically generate the plots based on the selected parameters
    observe({
      req(input$sel)
      lapply(input$sel, function(par){
        p <- ggplot(iris2, aes_string(x = "ID", y = par)) +
          geom_boxplot(aes(fill = Species, group=Species, color=Species)) +
          ggtitle(paste("Plot: ", par)) 
        output[[paste("plot", par, sep = "_")]] <- renderPlot({
          p
        },
        width = 380,
        height = 350)
      })
    })

    # Create plot tag list
    output$plots <- renderUI({
      req(input$sel)
      plot_output_list <- lapply(input$sel, function(par) {
        plotname <- paste("plot", par, sep = "_")
        plotOutput(plotname, height = '250px', inline=TRUE)
      })

      do.call(tagList, plot_output_list)

    })

  }

  shinyApp(ui, server)

It gives the following output: