如何直接到另一个网页点击一个tabpanel闪亮的应用

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？

---

更新

使用披的html centric way最新方法后：

Answer 1

有您能做到这一点许多方式R和光泽。这里有一个：

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.Here的也使用ui.R和server.R而不是一个实例的标签，当observeEvent()功能被触发一个文件。

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

事实上，我们也能做到这一点更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) {}) 
) 

Answer 2

只有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）写HTML使用tag和/或tags对象，使自己的函数

首先是简单地改写navbarPage功能产生你追求的那种输出的方式。

你可以看一下HTML制作的自举导航栏页面，并使用?tags或?tag

（这是一个新的功能添加到闪亮的一个伟大的方式进行复制。我写了一个包，速度把这个过程一个html字符串转换为等价的闪亮函数：https://github.com/shapenaji/midas）。但对于这样的事情来说，这太过分了。

2）将希望的对象分解为函数的输出。

在这里，我们真的只想用链接替换标头中的主对象，所以我们只需要这样做。

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

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

一个闪亮的对象，如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()的包装pped下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") 
     ) 
    ) 

EDIT 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...) 
    } 
)