Shiny app: exercise of ensuring input selection if tabs are changed

Question

In the shiny App below, I need to make variables X and Y be reactive across the scatter and density plots. That means that if the user changes the variable X and/or Y in a certain plot tab, so such variable(s) has/have to remain selected when the user to jump to another plot tab. E.g.: if Sepal.Width (in X) is selected in the 'scatter plot' tab, so 'Sepal.Width' has to remain selected if the user jump to the 'density plot' tab.

library(shiny)
library(shinydashboard)
library(shinyBS)
library(plotly)


shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "My plot"),
    dashboardSidebar(
      sidebarMenu(
        id = "tabs",
        menuItem("1. Data", icon = icon("circle-arrow-up"), tabName = "data"),
        menuItem("2. Choose plot", tabName = "charts", icon = icon("signal"),
                 menuSubItem("Scatter plot", tabName = "scatter"),
                 menuSubItem("Density plot", tabName = "density"))
      )),
    
    dashboardBody(
      tabItems(
        tabItem(tabName = "data",
                dataTableOutput("irisData")),
        
        tabItem(tabName = "scatter",
                uiOutput("panelPlot")),
        
        tabItem(tabName = "density",
                uiOutput("panelPlot2"))
      ))),
  
  server = function(input, output, session) {
    
    output$irisData <- renderDataTable({ 
      
      getModel <- reactive({
        names(iris) })
      
      varx <- selectInput("varsel.x", "Variable X", 
                          choices = as.list(getModel()), multiple = F)
      
      getModelnum <- reactive({
        filtroNumeric <- iris[sapply(iris, is.numeric)]
        names(filtroNumeric) })
      
      vary <- selectInput("varsel.y", "Variable Y",
                          choices = as.list(getModelnum()), multiple = F)
      
      output$panelPlot <- renderUI({
        bsCollapse(open = "Variables and plot",
                   bsCollapsePanel("Variables and plot",
                                   column(12,
                                          column(3,
                                                 fluidRow(
                                                   varx,
                                                   vary)),
                                          column(9,
                                                 fluidRow(align="center",
                                                          plotlyOutput('Gdisp')))
                                   ))) })
      
      output$panelPlot2 <- renderUI({
        bsCollapse(open = "Variables and plot",
                   bsCollapsePanel("Variables and plot",
                                   column(12,
                                          column(3,
                                                 fluidRow(
                                                   varx,
                                                   vary)),
                                          column(9,
                                                 fluidRow(align="center",
                                                          plotlyOutput('Gdensity')))
                                   ))) })
      
      output$Gdisp <- renderPlotly({
        p <- iris %>%
          ggplot(aes(x=!!rlang::sym(input$varsel.x), y=!!rlang::sym(input$varsel.y))) +
          geom_point()
      })
      
      output$Gdensity <- renderPlotly({
        p <- iris %>%
          ggplot(aes(x=!!rlang::sym(input$varsel.x), y=!!rlang::sym(input$varsel.y))) +
          geom_hex(bins=50) 
      })
      
      iris
    })
  })

score 0 · Answer 1 · answered May 09 '23 at 22:03

Here is a simple working example that you can use:

library(shiny)
library(shinydashboard)
library(shinyBS)
library(plotly)


shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "My plot"),
    dashboardSidebar(
      sidebarMenu(
        id = "tabs",
        menuItem("1. Data", icon = icon("circle-arrow-up"), tabName = "data"),
        menuItem("2. Choose plot", tabName = "charts", icon = icon("signal"),
                 menuSubItem("Scatter plot", tabName = "scatter"),
                 menuSubItem("Density plot", tabName = "density"))
      )),
    
    dashboardBody(
      tabItems(
        tabItem(tabName = "data",
                dataTableOutput("irisData")),
        
        tabItem(tabName = "scatter",
                bsCollapse(open = "Variables and plot",
                           bsCollapsePanel("Variables and plot",
                                           column(12,
                                                  column(3,
                                                         fluidRow(
                                                           selectInput("varsel.x", "Variable X", 
                                                                       choices = NULL, multiple = F),
                                                           
                                                           selectInput("varsel.y", "Variable Y",
                                                                       choices = NULL, multiple = F)
                                                          )),
                                                  column(9,
                                                         fluidRow(align="center",
                                                                  plotlyOutput('Gdisp')))
                                           )))
                ),
        
        tabItem(tabName = "density",
                plotlyOutput("Gdensity"))
      ))),
  
  server = function(input, output, session) {
    
    output$irisData <- renderDataTable({ 
      
      getModel <- reactive({
        names(iris) })
      
      getModelnum <- reactive({
        filtroNumeric <- iris[sapply(iris, is.numeric)]
        names(filtroNumeric) })
      
      
      updateSelectInput(session, "varsel.x", choices = as.list(getModel()))
      updateSelectInput(session, "varsel.y", choices = as.list(getModelnum()))


      output$Gdisp <- renderPlotly({
        p <- iris %>%
          ggplot(aes(x=!!rlang::sym(input$varsel.x), y=!!rlang::sym(input$varsel.y))) +
          geom_point()
      })
      
      output$Gdensity <- renderPlotly({
        p <- iris %>%
          ggplot(aes(x=!!rlang::sym(input$varsel.x), y=!!rlang::sym(input$varsel.y))) +
          geom_hex(bins=50) 
      })
      
      iris
    })
  })

Thanks for the answer, however, it does not solve my problem because I want the dropdown menus 'Variable X' and 'Variable Y' appear both in 'scatter plot' and 'density plot' tabs... — Hassan Camil David, May 10 '23 at 12:33

score 0 · Answer 2 · answered May 10 '23 at 13:12

I could solve the problem as follows:

shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "My plot"),
    dashboardSidebar(
      sidebarMenu(
        id = "tabs",
        menuItem("1. Data", icon = icon("circle-arrow-up"), tabName = "data"),
        menuItem("2. Choose plot", tabName = "charts", icon = icon("signal"),
                 menuSubItem("Scatter plot", tabName = "scatter"),
                 menuSubItem("Density plot", tabName = "density"))
      )),
    
    dashboardBody(
      tabItems(
        tabItem(tabName = "data",
                dataTableOutput("irisData")),
        
        tabItem(tabName = "scatter",
                uiOutput("panelPlot")),
        
        tabItem(tabName = "density",
                uiOutput("panelPlot2"))
      ))),
  
  server = function(input, output, session) {
    
    output$irisData <- renderDataTable({ 
      
      getModel <- reactive({
        names(iris) })
      
      varx1 <- selectInput("varsel.x1", "Variable X", 
                          choices = as.list(getModel()), multiple = F)
      varx2 <- selectInput("varsel.x2", "Variable X", 
                           choices = as.list(getModel()), multiple = F)
      
      getModelnum <- reactive({
        filtroNumeric <- iris[sapply(iris, is.numeric)]
        names(filtroNumeric) })
      
      vary1 <- selectInput("varsel.y1", "Variable Y",
                          choices = as.list(getModelnum()), multiple = F)
      vary2 <- selectInput("varsel.y2", "Variable Y",
                           choices = as.list(getModelnum()), multiple = F)
      
      observeEvent(input$varsel.x1, {
        updateSelectInput(session, "varsel.x2", selected = input$varsel.x1)  })
      observeEvent(input$varsel.x2, {
        updateSelectInput(session, "varsel.x1", selected = input$varsel.x2)  })
      observeEvent(input$varsel.y1, {
        updateSelectInput(session, "varsel.y2", selected = input$varsel.y1)  })
      observeEvent(input$varsel.y2, {
        updateSelectInput(session, "varsel.y1", selected = input$varsel.y2)  })
      
      output$panelPlot <- renderUI({
        bsCollapse(open = "Variables and plot",
                   bsCollapsePanel("Variables and plot",
                                   column(12,
                                          column(3,
                                                 fluidRow(
                                                   varx1,
                                                   vary1)),
                                          column(9,
                                                 fluidRow(align="center",
                                                          plotlyOutput('Gdisp')))
                                   ))) })
      
      output$panelPlot2 <- renderUI({
        bsCollapse(open = "Variables and plot",
                   bsCollapsePanel("Variables and plot",
                                   column(12,
                                          column(3,
                                                 fluidRow(
                                                   varx2,
                                                   vary2)),
                                          column(9,
                                                 fluidRow(align="center",
                                                          plotlyOutput('Gdensity')))
                                   ))) })
      
      output$Gdisp <- renderPlotly({
        p <- iris %>%
          ggplot(aes(x=!!rlang::sym(input$varsel.x1), y=!!rlang::sym(input$varsel.y1))) +
          geom_point()
      })
      
      output$Gdensity <- renderPlotly({
        p <- iris %>%
          ggplot(aes(x=!!rlang::sym(input$varsel.x2), y=!!rlang::sym(input$varsel.y2))) +
          geom_hex(bins=50) 
      })
      
   
      iris
    })
  })

Shiny app: exercise of ensuring input selection if tabs are changed

2 Answers2