Shiny NavBar add additional info

问题

Since my code is long I have considered the example code from here

I tried adding the following code (after last tabPanel) from here. But no luck.

tags$script(HTML("var header = $('.navbar > .container');
                        header.append('<div Company name text here>')"))

All I want is a plain text (information) to be on the right hand side of the NavBar.

回答1:

The following code gives you what you want. The main problem was with tour html tags.

library(shiny)


server <- function(input, output, session) {
  output$plot <- renderPlot({
    plot(cars, type=input$plotType)
  })

  output$summary <- renderPrint({
    summary(cars)
  })

  output$table <- DT::renderDataTable({
    DT::datatable(cars)
  })
}


ui <-shinyUI(navbarPage("Navbar!",
           tabPanel("Plot",
                    sidebarLayout(
                      sidebarPanel(
                        radioButtons("plotType", "Plot type",
                                     c("Scatter"="p", "Line"="l")
                        )
                      ),
                      mainPanel(
                        plotOutput("plot")
                      )
                    )
           ),
           tabPanel("Summary",
                    verbatimTextOutput("summary")
           ),


           tags$script(HTML("var header = $('.navbar > .container');
                       header.append('<div style=\"float:right\"><h3>Company name text here</h3></div>');
                       console.log(header)"))
))

shinyApp(ui = ui, server = server)

Hope it helps!

[EDIT]: Due to recent changes in the navbar classes the above code doesn't work anymore. The below code seems to work:

library(shiny)


server <- function(input, output, session) {
  output$plot <- renderPlot({
    plot(cars, type=input$plotType)
  })

  output$summary <- renderPrint({
    summary(cars)
  })

  output$table <- DT::renderDataTable({
    DT::datatable(cars)
  })
}


ui <-shinyUI(navbarPage("Navbar!",
                        tabPanel("Plot",
                                 sidebarLayout(
                                   sidebarPanel(
                                     radioButtons("plotType", "Plot type",
                                                  c("Scatter"="p", "Line"="l")
                                     )
                                   ),
                                   mainPanel(
                                     plotOutput("plot")
                                   )
                                 )
                        ),
                        tabPanel("Summary",
                                 verbatimTextOutput("summary")
                        ),


                        tags$script(HTML("var header = $('.navbar> .container-fluid');
                       header.append('<div style=\"float:right\"><h3>Company name text here</h3></div>');
                       console.log(header)"))
))

shinyApp(ui = ui, server = server)

The only change is that in the html script .navbar > .container has been change to .navbar> .container-fluid.

来源：https://stackoverflow.com/questions/41392365/shiny-navbar-add-additional-info

标签

Shiny