简体   繁体   中英

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!

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.

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)

在此处输入图片说明 在此处输入图片说明

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM