闪亮的导航栏页面中的搜索字段答案

【问题标题】：search field in shiny navbarPage闪亮的导航栏页面中的搜索字段
【发布时间】：2016-11-15 07:35:49
【问题描述】：

在一些tabPanel 之后，我试图在我的navbarPage 中添加一个全局搜索字段。我不确定这是否可能，因为我所有的测试都在navbar 之外产生了textInput。

rStudio 闪亮的布局指南指向 bootstrap navbar documentation ，他们实际上就是这样做的。但我无法用我闪亮的应用程序重现它。

library(shiny)

ui <- shinyUI(
  shiny::navbarPage('test',
    shiny::tabPanel('my app',
   fluidPage(

  # Application title
  titlePanel("Old Faithful Geyser Data"),

  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
    ),

    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  ))),

  ### Still inside navbarPage
  shiny::textInput("text", 
                   label=h3("Text input"), 
                   value="should be inside the navbar!")
))

server <- function(input, output, session) {
  output$distPlot <- renderPlot({

    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white')

  })
}

shinyApp(ui, server)

【问题讨论】：

这可能对你想做什么有一些见解stackoverflow.com/questions/36360146/…。

标签： r twitter-bootstrap shiny

【解决方案1】：

您可以通过稍微操作导航栏 HTML 来做到这一点。 Valter 是正确的——你可以通过完全用 HTML 构建菜单而不是使用 Shiny 来实现这一点。但是有一个更简单的方法：您可以在常规 Shiny 中构建导航栏，然后使用 htmltools 对其进行稍微修改。这是我认为目前提出的解决方案中最简洁的一个快速解决方案：

library(shiny)

navbarPageWithInputs <- function(..., inputs) {
  navbar <- navbarPage(...)
  form <- tags$form(class = "navbar-form", inputs)
  navbar[[3]][[1]]$children[[1]] <- htmltools::tagAppendChild(
    navbar[[3]][[1]]$children[[1]], form)
  navbar
}

ui <- navbarPageWithInputs(
  "Test app",
  tabPanel("tab1", "tab 1", textOutput("out")),
  tabPanel("tab2", "tab 2"),
  inputs = textInput("search", NULL, placeholder = "Search")
)

server <- function(input, output, session) {
  output$out <- renderText(input$search)
}

shinyApp(ui = ui, server = server)

基本上我创建了一个navbarPageWithInputs() 函数，它接受与navbarPage() 相同的所有参数，以及一个inputs 参数。这个函数所做的只是调用常规的navbarPage()，然后将给定的输入添加到 HTML。

【讨论】：

collapsible = FALSE 时效果很好。当collapsible = TRUE 输入未与其他导航栏标签对齐时。 navbar[[3]][[1]]$children[[1]]$children[[2]] 在这种情况下有效
根据闪亮的最新版本，导航栏对象的结构发生了变化。这对我有用： navbar[[4]][[1]][[1]]$children[[1]]$children[[2]]

【解决方案2】：

在基本 Shiny 中，如果重新渲染当前 tabPanel 成本不高，您可以使用 tabPanel 来完成：

ui <- navbarPage('test',id='test',
                 tabPanel('my app1',
                          titlePanel("Old Faithful Geyser Data1"),
                          sidebarLayout(
                            sidebarPanel(
                              sliderInput("bins",
                                          "Number of bins:",
                                          min = 1,
                                          max = 50,
                                          value = 30)),
                            mainPanel(plotOutput("distPlot1")))),
                 tabPanel('my app2',
                          titlePanel("Old Faithful Geyser Data2"),
                          sidebarLayout(
                            sidebarPanel(
                              sliderInput("bins",
                                          "Number of bins:",
                                          min = 1,
                                          max = 50,
                                          value = 30)),
                            mainPanel(plotOutput("distPlot2")))),
                 tabPanel( value= "search_panel",
                           textInput("search", label=NULL, value="Search"))
                )

server <- function(input, output, session) {
  observe({
    if(!is.null(input$test)){
      if(input$test=="search_panel")     # Go back to last active panel
        updateNavbarPage(session, 'test', selected = selected_panel)
      else                               # Save active panel
        selected_panel <<- input$test
      }
    })
  searchtext <- reactive({
    if(!is.null(input$search))
       if(input$search!="Search")
         return(input$search)
    return(NULL)
    })
  output$distPlot1 <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white', 
         main=ifelse(is.null(searchtext()), "Alt title 1", searchtext()))
    })
  output$distPlot2 <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white', 
         main=ifelse(is.null(searchtext()), "Alt title 2", searchtext()))
    })
}

shinyApp(ui, server)

【讨论】：

【解决方案3】：

这是一种可能的方法，用 HTML 重构菜单。它看起来不是很干净，但它可以满足您的需求。

app.R

library(shiny)

    ui <- shinyUI(
            tagList(
                    bootstrapPage(
                    HTML('
                         <nav class="navbar navbar-default" role="navigation">
                            <div class="navbar-header">
                                    <button type="button" class="navbar-toggle" data-toggle="collapse" data-target="#bs-example-navbar-collapse-1">
                                            <span class="sr-only">Toggle navigation</span>
                                            <span class="icon-bar"></span>
                                            <span class="icon-bar"></span>
                                            <span class="icon-bar"></span>
                                    </button>
                                    <a class="navbar-brand" href="#">Old Faithful Geyser Data</a>
                            </div>
                            <div class="collapse navbar-collapse" id="bs-example-navbar-collapse-1">
                                    <ul class="nav navbar-nav">
                                            <li class="active"><a href="#plot1" data-toggle="tab" data-value="Plot1">First</a></li>
                                            <li><a href="#plot2" data-toggle="tab" data-value="Plot2">Second</a></li>
                                    </ul>
                                    <div class="col-sm-3 col-md-3">
                                            <form class="navbar-form" role="search">
                                                    <div class="input-group">
                                                            <input id="searchBox" type="text" class="form-control" placeholder="Search" name="q">
                                                    </div>
                                            </form>
                                    </div>
                            </div><!-- /.navbar-collapse -->
                         </nav>
                         '),
                    tags$div(class="container-fluid", 
                             tags$div(class="tab-content",
                                      HTML('<div class="tab-pane active" data-value="Plot1" id="plot1">'),
                                      sliderInput("bins1",
                                                  "Number of bins:",
                                                  min = 1,
                                                  max = 50,
                                                  value = 30),
                                      plotOutput("distPlot1"),
                                      verbatimTextOutput("searchBoxValuePlot1"),
                                      HTML('</div>'),
                                      HTML('<div class="tab-pane" data-value="Plot2" id="plot2">'),
                                      sliderInput("bins2",
                                                  "Number of bins:",
                                                  min = 1,
                                                  max = 50,
                                                  value = 30),
                                      plotOutput("distPlot2"),
                                      verbatimTextOutput("searchBoxValuePlot2"),                                  
                                      HTML('</div>')

                             )

                    )
            )
            ))

    server <- function(input, output, session) {
            output$distPlot1 <- renderPlot({

                    # generate bins based on input$bins from ui.R
                    x    <- faithful[, 2]
                    bins <- seq(min(x), max(x), length.out = input$bins1 + 1)

                    # draw the histogram with the specified number of bins
                    hist(x, breaks = bins, col = 'darkgray', border = 'white')

            })
            output$distPlot2 <- renderPlot({

                    # generate bins based on input$bins from ui.R
                    x    <- faithful[, 1]
                    bins <- seq(min(x), max(x), length.out = input$bins2 + 1)

                    # draw the histogram with the specified number of bins
                    hist(x, breaks = bins, col = 'darkgray', border = 'white')

            })
            searchBoxValue <- reactive({
                    input$searchBox
            })
            output$searchBoxValuePlot1 <- renderPrint({
                    paste("You entered: ", searchBoxValue(), "and you are on the first link", sep = " ")
            })
            output$searchBoxValuePlot2 <- renderPrint({
                    paste("You entered: ", searchBoxValue(), "and you are on the second link", sep = " ")
            })
    }

    shinyApp(ui, server)

【讨论】：