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

Question

我有以下闪亮的应用程序：

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)

它产生：

如那里所述。 单击“主页”按钮tabPanel()后，如何将页面定向到www.google.com？

---

更新资料

在使用Phi的html centric way最新方法之后：

Answer 1

仅UI的解决方案

无需使用反应式逻辑进行重定向。 我们只想在html中放置一个链接。

---

有时，闪亮会让您忘记您真正在做什么，只是在ui上编写html。

例如，如果我们将navbarPage的输出打印到控制台， navbarPage得到：

> 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>

这里的问题是，功能navbarPage正在应用一些逻辑，它假定您只在其中放置了tabPanel对象，并且对这些对象进行了非常特殊的操作（它在该位置创建了一个链接，因此我们放置在其中的任何链接都会无效）。 我们可以通过以下两种方式之一进行更改。

1）使用tag和/或tags对象编写HTML并编写自己的函数

第一种方法是简单地重写navbarPage函数，使其产生所需的输出类型。

您可以查找用于制作引导导航页的html，并使用?tags或?tag复制它

（这是向闪亮添加新功能的好方法。我编写了一个程序包，通过将html字符串转换为等效的闪亮功能来加快此过程： https : //github.com/shapenaji/midas ）。 但是对于这样的事情，那太过分了。

2）将所需的对象加入到函数的输出中。

在这里，我们真的只想用链接替换标头中的该home对象，因此就可以这样做。

我们保存导航栏功能的输出。

然后，用所需的hack ... err ...链接替换对象的该部分。

像navbarPage的输出一样，一个有光泽的对象只是一个列表，我们可以像导航列表一样导航到底部。

（在此示例中，我们需要花一点时间才能找到该对象。它在嵌套列表中相当深。但是您可以在控制台中浏览该对象以替换您想要的部分。我只是剥离了该列表一次一个。）

（我删除了shinyUI和shinyServer函数，因为在当前版本的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...)
  }
)

---

当navbarPage()包装在fixedPage()下时，如何修改

答：更改您要修改的内容，整个导航栏页面现在位于固定页面内，这会将page[[3]][[1]]$children[[1]]到开头

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")
        )
      )

编辑2：一种更清洁的方法：

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

您可以通过多种方式在R和Shiny中完成此操作。 这是一个：

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")
  }
})
})
)

基本上所有发生的事情是在打开URL的浏览器窗口时单击选项卡时触发了observeEvent()函数。这也是使用ui.R和server.R而不是单个文件的示例。

用户界面

library(shiny)

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

服务器

library(shiny)

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

实际上，我们也可以按照Shape的建议，以更加HTML中心的方式进行此操作，并且更加简单：

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) {})
)