0

I want to create a r shiny app in which for each y variable one tab is produced (so tabs must be dynamically generated) and in each tab the plots are in two columns and n rows (as in the figure). However, I received the following error:

`x` must contain exactly 1 expression, not 2

In fact, I want to combine the two codes to create what I described above: Code 1: This code creates one tab for every y variable

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "x", label = "X var", choices = names(mtcars), selected = names(mtcars)[1], multiple = F),
      selectizeInput(inputId = "y", label = "Y var", choices = names(mtcars), selected = names(mtcars)[1], multiple = T)
      
    ),
    mainPanel(
      uiOutput("plots")
    )
  )
)

server <- function(input, output, session) {
  
  output$plots <- renderUI({
    plt_list <- list()
    plt_list <- lapply(input$y, function(y){
      renderPlot({
        ggplot(mtcars, aes_string(input$x, y)) + geom_point()
      })
      
    })
    
  names(plt_list) <- input$y
  
  do.call(tabsetPanel, c(id='tab',lapply(input$y, function(y) {
    tabPanel(
      title=paste0('tab ', y), 
      fluidRow(column(6, plt_list[[y]]))
    )
  })))
  })
}

shinyApp(ui, server)

enter image description here

Code 2: This code creates multiple plots of y vs. different x variables, and the plots are arranged in a way so that we have two columns and n rows.

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(selectInput(inputId = "y", label = "Y", choices = names(mtcars), selected = names(mtcars)[1], multiple = F),
                 selectizeInput(inputId = "xvars", label = "X", choices = names(mtcars), selected = names(mtcars)[1],
                                multiple = T)),
    mainPanel(uiOutput("allplots"))
  )
  
)

server <- function(input, output, session) {
  
  output$allplots <- renderUI({
    plt_list <- list()
    
    
    
    plt_list <- lapply(input$xvars, function(x){
      renderPlotly({
        mtcars %>% ggplot(aes_string(x = x, y = input$y)) + geom_point()
      })
    })
   
    
    if (length(input$xvars) == 1) {
      plottoUI <- fluidRow(column(12, plt_list[1]))
    } else {
      plottoUI <- fluidRow(
        lapply(1:length(input$xvars), function(x) column(6, plt_list[x]))
      )
    }
    
    return(plottoUI)
  })
  
  
  
}

shinyApp(ui, server)

enter image description here

Code 3: The combination of the codes above that results in the error:

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(selectizeInput(inputId = "y", label = "Y", choices = names(mtcars), selected = names(mtcars)[1:2], multiple = T),
                 selectizeInput(inputId = "xvars", label = "X", choices = names(mtcars), selected = names(mtcars)[1:3],
                                multiple = T)),
    mainPanel(uiOutput("allplots"))
  )
  
)

server <- function(input, output, session) {
  
  output$allplots <- renderUI({
    plt_list <- list()
    
    
    plots <- lapply(input$y, function(y){
      plt_list <- lapply(input$xvars, function(x){
        renderPlotly({
          mtcars %>% ggplot(aes_string(x = x, y = input$y)) + geom_point()
        })
      })
    })
    
    names(plots) <- input$y
    plotarrange <- lapply(input$y, function(y){
      
      if (length(input$xvars) == 1) {
        plottoUI <- fluidRow(column(12, plots[[y]][1]))
      } else {
        plottoUI <- fluidRow(
          lapply(1:length(input$xvars), function(x) column(6, plots[[y]][x]))
        )
      }
      return(plottoUI)
      
    })
    names(plotarrange) <- input$y
    do.call(tabsetPanel, c(id='tab',lapply(input$y, function(y) {
      tabPanel(
        title=paste0('tab ', y), 
        plotarrange[[y]]
        )
      
    })))
    
    
  })
  
  
  
}

shinyApp(ui, server)

enter image description here

What is the source of the error and how do I resolve it ?

Abbas
  • 807
  • 7
  • 14

1 Answers1

0

I found the source of the error in code 3, input$y should have been changes to y as follows

plots <- lapply(input$y, function(y){
      plt_list <- lapply(input$xvars, function(x){
        renderPlotly({
          mtcars %>% ggplot(aes_string(x = x, y = y)) + geom_point()
        })
      })
    })

Therefore:

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(selectizeInput(inputId = "y", label = "Y", choices = names(mtcars), selected = names(mtcars)[1:2], multiple = T),
                 selectizeInput(inputId = "xvars", label = "X", choices = names(mtcars), selected = names(mtcars)[1:3],
                                multiple = T)),
    mainPanel(uiOutput("allplots"))
  )
  
)

server <- function(input, output, session) {
  
  rval <- reactiveValues(
    plt_list = NULL
  )
  output$allplots <- renderUI({
    plt_list <- list()
    
    
    plots <- lapply(input$y, function(y){
      rval$plt_list <- lapply(input$xvars, function(x){
        renderPlotly({
          mtcars %>% ggplot(aes_string(x = x, y = y)) + geom_point()
        })
      })
    })
    
    names(plots) <- input$y
    plotarrange <- lapply(input$y, function(y){
      
      if (length(input$xvars) == 1) {
        plottoUI <- fluidRow(column(12, plots[[y]][1]))
      } else {
        plottoUI <- fluidRow(
          lapply(1:length(input$xvars), function(x) column(6, plots[[y]][x]))
        )
      }
      return(plottoUI)
      
    })
    names(plotarrange) <- input$y
    do.call(tabsetPanel, c(id='tab',lapply(input$y, function(y) {
      tabPanel(
        title=paste0('tab ', y), 
        plotarrange[[y]]
        )
      
    })))
    
    
  })
  
  
  
}

shinyApp(ui, server)
Abbas
  • 807
  • 7
  • 14