2016-11-15 26 views
2

我试图在tabPanel之后得到一个全局搜索字段到我的navbarPage。我不确定是否有可能,因为我的所有测试在navbar之外生成textInput闪亮navbarPage中的搜索字段

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) 
+0

这可能有一些你想要做什么的见解http://stackoverflow.com/questions/36360146/checkbox-widget-within-navbar-shiny。 – emilliman5

回答

5

你可以做到这一点稍微操纵navbar 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中。

+0

'collapsible = FALSE'时效果很好。当'collapsible = TRUE'时,输入不与其他导航栏标签对齐。 'navbar [[3]] [[1]] $ children [[1]] $ children [[2]]'在这种情况下工作 – Vincent

0

这是一种可能的方式,用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) 
1

在基地有光泽,你可以使用一个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) 
0

这是另一种可能的方式。在tabPanel中使用标题参数来插入您自己的HTML代码。

ui <- shiny::navbarPage(
    title = 'app title', 
    tabPanel(title = 'first panel'), 
    tabPanel(title = tags$form(class = "navbar-form", tags$input(id = 'search', type = 'text'))), 
    tabPanel(title = 'second panel') 
)