Question

我有以下 Shiny 应用

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("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）将所需对象藏入函数输出。

在这里，我们真的只想用标题替换标题中的那个主对象，所以让我们这样做。

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

然后我们用我们想要的hack替换对象的那部分...错误...链接。

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

（在这一步中，我们需要深入挖掘一下这个对象。它在嵌套列表中相当深。但你可以在控制台中探索对象来替换你所追求的部分。我只是一次剥掉一个清单。）

（我已经删除了shinyUI和shinyServer函数，因为当前版本的闪亮不再需要那些包装器）

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而不是单个文件的示例。

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

事实上，正如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) {})
)

点击Shiny App中的tabPanel后，如何指向其他网页

2 个答案: