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()。预期的结果是，当我在＆＃34;面板1和＃34;中更改输入值时它将在＆＃34; Panel 2＆＃34;中采用相同的值;反之亦然。当然，过滤也应该应用于两个面板上的表。另外，物种的输入在两个面板上共享，但是萼片长度的滑块应该仅出现在面板1上。因此，sidebarLayout（）不是解决方案。

谢谢！

Answer 1

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

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我将inputId更改为＆＃34; species1＆＃34;和＆＃34;种类2＆＃34;
2）我在您的session函数中添加了server参数 3）我创建了一个名为reactiveValues的{{1}}对象，其中包含一个名为Selected的元素，用于存储当前选定的种类，最初为Species。
4）当用户选择一个物种并将该选项存储在NULL时，前两个observeEvents将会触发。使用哪个选择器无关紧要，并且始终具有最后选择的值 5）接下来的两个Selected$Species会更新两个observeEvent以使所选的选项为selectInput，以便在一个标签中更改值时会自动改变另一个。你需要在这里使用Selected$Species参数，这就是我之前添加它的原因 6）我根据session

更改了表格

这个系统有一些优点。使用更多Selected$Species添加更多标签很容易，只需为它们添加新的selecteInput语句即可。如果你有很多这样的东西，那么看看闪亮的模块可能是值得的。

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

Answer 2

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

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)

在Rshiny app中重用输入

2 个答案: