Reputation: 1703
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
Reputation: 12664
Here is a solution that uses 2 selectInput
s 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 inputId
s 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 observeEvent
s update the two selectInput
s 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 selecteInput
s 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
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)
Upvotes: 1