单击Shiny App中的tabPanel后如何定向到另一个网页

Question

I have the following Shiny app:

library(shiny)

shinyApp(
  ui <- shinyUI(
    navbarPage("X-men",
               tabPanel("",icon = icon("home", lib = "glyphicon")  ),
               tabPanel("Plot")
            )),
  server <- shinyServer(function(input, output) {})
)
# Run the application 
shinyApp(ui = ui, server = server)

It produces:

As stated there. How can I direct the page to www.google.com after clicking Home button tabPanel() ?

---

Update

After using Phi's html centric way latest method:

Answer 1

A UI-only solution

There's no need to use reactive logic to redirect. We just want to put a link in the html.

---

Sometimes shiny lets you forget that what you're really doing is just writing html on the ui.

For example, if we print the output of navbarPage to the console we get:

> navbarPage("X-men",
+            tabPanel("",icon = icon("home", lib = "glyphicon")  ),
+            tabPanel("Plot")
+ )
<nav class="navbar navbar-default navbar-static-top" role="navigation">
  <div class="container-fluid">
    <div class="navbar-header">
      <span class="navbar-brand">X-men</span>
    </div>
    <ul class="nav navbar-nav">
      <li class="active">
        <a href="#tab-8961-1" data-toggle="tab" data-value="">
          <i class=" glyphicon glyphicon-home"></i>

        </a>
      </li>
      <li>
        <a href="#tab-8961-2" data-toggle="tab" data-value="Plot">Plot</a>
      </li>
    </ul>
  </div>
</nav>
<div class="container-fluid">
  <div class="tab-content">
    <div class="tab-pane active" data-value="" data-icon-class="glyphicon glyphicon-home" id="tab-8961-1"></div>
    <div class="tab-pane" data-value="Plot" id="tab-8961-2"></div>
  </div>
</div>

The issue here is that the function navbarPage is applying some logic, it assumes that you only put tabPanel objects up there and it is doing something very special with the objects (it's creating a link in that spot, so any link we put inside that will get nullified). We can change that in one of two ways.

1) Write HTML using the tag and/or tags objects and make your own function

The first is simply to rewrite the navbarPage function in a way that produces the kind of output you're after.

You can look up the html for making a bootstrap navbar page and replicate it using ?tags or ?tag

(This is a great way to add new functionality to shiny. I wrote a package to speed this process by turning an html string into equivalent shiny functions: https://github.com/shapenaji/midas ). But for something like this, that's overkill.

2) Hack in the desired object to the output of the function.

Here, we really just want to replace that home object in the header with a link, so lets just do that.

We save the output of the navbar function.

Then we replace that part of the object with our desired hack ...err... link.

A shiny object, like the output of navbarPage is just a list, and we can navigate our way to the bottom in the same way we would navigate a list.

(In this one, we have to dig a little bit to get down to the object. It's fairly deep in the nested list. But you can explore the object in the console to replace the parts you're after. I just peeled the list one at a time.)

(I have removed the shinyUI and shinyServer functions, as those wrappers are no longer necessary in the current version of shiny)

library(shiny)

shinyApp(

  ui = {
      page <- 
        navbarPage("X-men",id = "navibar",
                   tabPanel("placeholder"),
                   tabPanel("Plot",value = "plot"),
                   selected = "plot"
        )
      # Replace the second object in the navbar with the link
      page[[3]][[1]]$children[[1]]$children[[2]]$children[[1]] <- 
        tags$li(tags$a(
          href = 'http://google.com', 
          icon("home", lib = "glyphicon")
          )
        )
      # Finally return the page object, modified
      page
  },

  server = function(input, output, session) {
    # No server code necessary (yet...)
  }
)

---

How can I modify when navbarPage() is wrapped under fixedPage()

Answer: Change what you're modifying, the entire navbar page is inside the fixed page now, which adds page[[3]][[1]]$children[[1]] to the beginning

page[[3]][[1]]$children[[1]][[3]][[1]]$children[[1]]$children[[2]]$children[[1]] <- 
      tags$li(
        tags$a(
          href = 'http://google.com', 
          icon("home", lib = "glyphicon")
        )
      )

EDIT 2: A Cleaner way to do it:

library(shiny)

shinyApp(

  ui = {
      page <- 
        navbarPage("X-men",id = "navibar",
                   tabPanel("placeholder"),
                   tabPanel("Plot",value = "plot"),
                   selected = "plot"
        )
      # Replace the second object in the navbar with the link
      page[[3]][[1]]$children[[1]]$children[[2]]$children[[1]] <- 
        tags$li(tags$a(
          href = 'http://google.com', 
          icon("home", lib = "glyphicon")
          )
        )
      # Finally return the page object, wrapped by fixedPage
      fixedPage(page)
  },

  server = function(input, output, session) {
    # No server code necessary (yet...)
  }
)

Answer 2

There are many ways you can accomplish this in R and Shiny. Here's one :

library(shiny)
shinyApp(
shinyUI(
uiOutput("navigate")
),

shinyServer(function(input, output, session) {
output$navigate <- renderUI({
  fixedPage(
    navbarPage("X-men",id = "navibar",
               tabPanel("",icon = icon("home", lib = "glyphicon"),value = "home"),
               tabPanel("Plot",value = "plot"),
               selected = "plot"
    )
  )
})
observeEvent(input$navibar,{
  if(input$navibar == "home"){
    browseURL("https://www.google.com")
  }
})
})
)

Basically all thats happening is that the observeEvent() function is triggered when the tab is clicked on opening a browser window to the URL.Here's also an example of using ui.R and server.R rather than a single file.

ui.R

library(shiny)

shinyUI(
fluidPage(
navbarPage("X-men",id = "navibar",
                         tabPanel("",icon = icon("home", lib =  "glyphicon"),value = "home"),
                         tabPanel("Plot",value = "plot"),
                         selected = "plot"
)
)
)

server.R

library(shiny)

shinyServer(function(input, output) {
observeEvent(input$navibar,{
if(input$navibar == "home"){
  browseURL("https://www.google.com")
}
})
})

Indeed we can also do this in a more html centric way, as Shape suggested, with a much simpler :

library(shiny)

shinyApp(
ui <- shinyUI(
navbarPage("X-men",
           tabPanel(tags$a(href = 'http://google.com', icon("home", lib = "glyphicon"))),
           tabPanel("Plot")
        )),
server <- shinyServer(function(input, output) {})
)