phillyooo
phillyooo

Reputation: 1703

Reuse input in Rshiny app

i'd like to reuse an input field in a tabbed shiny app. my code is below.

library(shiny)

ui <- navbarPage("Iris data browser",
    tabPanel("Panel 1",
             selectInput("species", "Species",
                         unique(iris$Species)),
             sliderInput("sepal.length", "Sepal length",
                         4.3,7.9,4.5,.1),
             tableOutput("table1")),

    tabPanel("Panel 2",
             selectInput("species", "Species",
                         unique(iris$Species)),
             tableOutput("table2")))


server <- function(input, output) {
    output$table1 <- renderTable({
        iris[iris$Species == input$species & iris$Sepal.Length <= input$sepal.length,c("Sepal.Length","Sepal.Width")]
    })

    output$table2 <- renderTable({
        iris[iris$Species == input$species,c("Petal.Length","Petal.Width")]
    })
}

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

i'd like to use the same selectInput() on both panels. the expected result is that when i change the input value in "Panel 1" it will take on the same value in "Panel 2" and vice versa. of course, the filtering should also be applied to the tables on both panels. additionally, the input for species is shared on both panels, but the slider for sepal length should only appear on panel 1. therefore, sidebarLayout() is no solution.

thanks!

Upvotes: 2

Views: 1407

Answers (2)

John Paul
John Paul

Reputation: 12664

Here is a solution that uses 2 selectInputs but links them so that they have the same choices selected. Explanation of changes is below the code:

library(shiny)

ui <- navbarPage("Iris data browser",
                 tabPanel("Panel 1",
                          selectInput("species1", "Species", choices=unique(iris$Species)),
                          sliderInput("sepal.length", "Sepal length",
                                      4.3,7.9,4.5,.1),
                          tableOutput("table1")),

                 tabPanel("Panel 2",
                          selectInput("species2", "Species", choices=unique(iris$Species) ),
                          uiOutput("select2"),
                          tableOutput("table2")))


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

  Selected<-reactiveValues(Species=NULL)



  observeEvent(input$species1, Selected$Species<-(input$species1))
  observeEvent(input$species2, Selected$Species<-(input$species2))

  observeEvent(Selected$Species, updateSelectInput(session, "species1", selected=Selected$Species))
  observeEvent(Selected$Species, updateSelectInput(session, "species2", selected=Selected$Species))

  output$table1 <- renderTable({
    iris[iris$Species == Selected$Species & iris$Sepal.Length <= input$sepal.length,c("Sepal.Length","Sepal.Width")]
  })

  output$table2 <- renderTable({
    iris[iris$Species == Selected$Species ,c("Petal.Length","Petal.Width")]
  })
}

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

1) In the ui I changed the inputIds to "species1" and "species2"
2) I added the session parameter to your server function.
3) I created a reactiveValues object called Selected with an element called Species to store the currently selected species, it starts out as NULL.
4) The first two observeEvents will fire when the user chooses a species and stores that choice in Selected$Species. It does not matter which selector is used and will always have the value selected last.
5) The next two observeEvents update the two selectInputs to have the the selected choice be Selected$Species so that when you change the value in one tab it will change in the other automatically. You need to use the session argument here which is why I added it earlier.
6) I changed the tables to filter based on Selected$Species

There are a few advantages of this system. It would be easy to add more tabs with more selecteInputs and just add new observeEvent statements for them. If you have a bunch of these it might be worth you while to look into shiny modules.

Here, the tables just use Selected$Species but if you wanted to you could add more logic and they could sometimes update and sometimes not if that made sense for your app. That allows you to produce complicated behavior -for example if some values don't make sense for one of your displays you could catch that ahead of time and alert the user or display something else.

Upvotes: 5

zx8754
zx8754

Reputation: 56149

Not ideal, but this is what I meant in the comments:

library(shiny)

ui <- navbarPage("Iris data browser",
                 position = "fixed-top",
                 tabPanel("SideMenu",
                          sidebarPanel(
                            #push it down 70px to avoid going under navbar
                            tags$style(type="text/css", "body {padding-top: 70px;}"),
                            selectInput("species", "Species",
                                        unique(iris$Species)),
                            conditionalPanel("input.myTabs == 'Panel 2'",
                                             sliderInput("sepal.length", "Sepal length",
                                                         4.3,7.9,4.5,.1))
                            )
                 ),
                 mainPanel(
                   tabsetPanel(id = "myTabs",
                     tabPanel("Panel 1",
                              tableOutput("table1")),
                     tabPanel("Panel 2",
                              tableOutput("table2"))
                   )
                 )
)


server <- function(input, output) {
  output$table1 <- renderTable({
    iris[iris$Species == input$species,c("Sepal.Length","Sepal.Width")]
  })

  output$table2 <- renderTable({
    iris[iris$Species == input$species,c("Petal.Length","Petal.Width")]
  })
}

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

enter image description here enter image description here

Upvotes: 1

Related Questions