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