在 Rshiny 应用程序中重用输入

Question

我想在选项卡式闪亮应用中重复使用输入字段。我的代码如下。

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)

我想在两个面板上使用相同的selectInput()。预期的结果是，当我更改“面板 1”中的输入值时，它将在“面板 2”中采用相同的值，反之亦然。当然，过滤也应该应用于两个面板上的表格。此外，物种的输入在两个面板上共享，但萼片长度的滑块应该只出现在面板 1 上。因此，sidebarLayout() 不是解决方案。

谢谢！

Answer 1

这是一个使用 2 个selectInputs 的解决方案，但将它们链接起来，以便它们选择相同的选项。更改说明在代码下方：

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) 在ui 中，我将inputIds 更改为“species1”和“species2”
2) 我添加了session server 函数的参数。
3) 我创建了一个名为 Selected 的 reactiveValues 对象，其中包含一个名为 Species 的元素来存储当前选择的物种，它以 @ 开头987654330@.
4) 前两个observeEvents 将在用户选择一个物种并将该选择存储在Selected$Species 时触发。使用哪个选择器都没有关系，并且总是最后选择的值。
5)接下来的两个observeEvents 更新两个selectInputs 以使选择的选项为Selected$Species 这样当您在一个选项卡中更改值时，它会在另一个选项卡中自动更改。您需要在此处使用 session 参数，这就是我之前添加它的原因。
6)我更改了表格以根据 Selected$Species 进行过滤

这个系统有几个优点。使用更多selecteInputs 添加更多选项卡并为它们添加新的observeEvent 语句会很容易。如果你有一堆这样的东西，那么研究闪亮的模块可能是值得的。

在这里，表格只使用Selected$Species，但如果您愿意，您可以添加更多逻辑，它们有时可以更新，有时如果这对您的应用有意义，则有时不会。这允许您产生复杂的行为 - 例如，如果某些值对您的其中一个显示器没有意义，您可以提前捕捉到并提醒用户或显示其他内容。

Answer 2

不理想，但这就是我在 cmets 中的意思：

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)