Search code examples
rplotshinydynamicreactive

Dynamically plotting in tabsetPanels in shiny R


I’m working on a Shiny app where I need to dynamically plot data in a tabPanel of a tabsetPanel. I’ve been trying to adapt the example from this StackOverflow answer , which demonstrates how to dynamically generate a number of plots with reactive data. However, when I modify the code to plot within a tabPanel, the plots don’t render in the mainPanel.

Here’s the code I’m working with:

library(shiny)
library(tidyverse)

# Load data
data("iris")

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

UI_plot <- function(id) {
  ns <- NS(id)
  tabPanel("Plot",
           sidebarPanel(
             helpText("PLOT X:")
           ),
           mainPanel(
             helpText("PLOT:"),
             uiOutput(ns("plots"))
           )
  )
}

# server
server_plot <- function(input, output, session){
  
  # Select columns based on the condition
  sel <- c("Sepal.Length", "Sepal.Width")
  
  # Dynamically generate the plots based on the selected parameters
  observe({
    lapply(sel, function(par){
      p <- ggplot(test, aes_string(x = "Species", y = par)) +
        geom_boxplot(aes(fill = Species, group=Species, color=Species)) +
        ggtitle(paste("Plot: ", par)) 
      output[[paste("plot", par, sep = "_")]] <- renderPlot({
        print(p) # Add print() function here
      },
      width = 380,
      height = 350)
    })
  })
  
  # Create plot tag list
  output$plots <- renderUI({
    plot_output_list <- lapply(sel, function(par) {
      plotname <- paste("plot", par, sep = "_")
      print(plotname)
      plotOutput(plotname, height = '450px', inline=TRUE)
    })
    
    do.call(tagList, plot_output_list)
    
  })
}

shinyApp(
  ui = fluidPage(
    titlePanel('TestX'),
    tabsetPanel(
      UI_plot('Plot')
    )
  ),
  server = function(input, output, session) {
    callModule(server_plot, 'Plot')
  }
)

In my real-world application, I have multiple tabPanels where I filter my data and select columns, hence the sel variable in my code. For this simplified example, I’m using the iris dataset and selecting the Sepal.Length and Sepal.Width columns.

I’ve added a print statement to check whether the plots might have the same ID, but the IDs appear to be unique.

Despite this, the plots are not appearing in the mainPanel as expected. I’m not sure what I’m doing wrong. Could it be an issue with the scope of the observe function, or perhaps something else?

Any insights or suggestions would be greatly appreciated. If you need any additional information about my goal or the specifics of my problem, please don’t hesitate to ask.


Solution

  • This hasn't got anything to do with using a tabsetPanel - it's because you are using modules. You were on the right track with the namespace being the origin of the problem. Inside a renderUI used in a module you need to namespace *Output objects with session$ns but when you create the output$ you just use the normal ID. I made a few other changes too as your use of Plot throughout made things quite confusing.

    library(shiny)
    library(tidyverse)
    
    # Load data
    data("iris")
    
    # Add row id
    test <- iris %>% mutate(ID = 1:n())
    
    UI_plot <- function(id) {
      ns <- NS(id)
      tabPanel("Plot",
               sidebarPanel(
                 helpText("PLOT X:")
               ),
               mainPanel(
                 helpText("PLOT:"),
                 uiOutput(ns("plots"))
               )
      )
    }
    
    # server
    server_plot <- function(id){
      moduleServer(id, function(input, output, session) {
      # Select columns based on the condition
      sel <- c("Sepal.Length", "Sepal.Width")
    
      # Dynamically generate the plots based on the selected parameters
      observe({
        lapply(sel, function(par){
          output[[par]] <- renderPlot({
            ggplot(test, aes_string(x = "Species", y = par)) +
              geom_boxplot(aes(fill = Species, group=Species, color=Species)) +
              ggtitle(paste("Plot: ", par))
          })
        })
      })
    
      # Create plot tag list
      output$plots <- renderUI({
        tagList(lapply(sel, function(par) {
          plotname <- session$ns(par)
          print(plotname)
          plotOutput(plotname)
        }))
        })
    
    })
    }
    
    shinyApp(
      ui = fluidPage(
        titlePanel('TestX'),
        tabsetPanel(
          UI_plot('test')
        )
      ),
      server = function(input, output, session) {
        do.call(server_plot, args = list(id = 'test'))
      }
    )