直接链接到带R闪亮仪表板的tabItem

Question

我使用闪亮的仪表板模板来生成我的Web UI。

我想动态生成一个信息框，当计算完成时，链接指向dashboardBody中的一个tabItems。

例如， 我可以把这个在我的tabItem1输出，

renderInfoBox({ 
    infoBox("Completed", 
    a("Computation Completed", href="#tabItem2"), 
    icon = icon("thumbs-o-up"), color = "green" 
) 
}) 

但问题是，当我点击链接，它什么都不做。我想跳到tabItem2。当我将鼠标悬停在它上面时，链接href似乎有效。

谢谢！

---

更新： 除了使用的Javascript，看起来像使用shinydashboard包actionLink和updateTabItems功能也能发挥作用。

Answer 1

对于冗长的代码示例，我表示歉意，但我不得不从shinydashboard主页复制tabItems的示例。

您的方法只有几个问题。首先，如果您要检查menuItems，您会发现实际标签的ID不是tabItem2，而是shiny-tab-tabItem2。这加上a标签内的额外属性data-toggle="tab"就足以打开所需的选项卡。代码段：

a("Computation Completed", href="#shiny-tab-tabItem2", "data-toggle" = "tab") 

但是，这是有其局限性。首先也是最明显的，边栏中的menuItem的状态未设置为active。这看起来很奇怪，有人可能不相信，其中一个已被移到另一个标签。

第二，也就不那么明显了，如果您听取选项卡更改（在服务器端），您将无法获得有关此选项卡开关的信息。那些被点击的menuItem触发，并且该标签本身将不报告，如果它是可见的或隐藏的。

因此，我的方法是模拟点击相应的menuItem，从而解决上述所有问题。

代码示例：

library(shiny) 
library(shinydashboard) 

ui <- shinyUI(
    dashboardPage(
    dashboardHeader(title = "Some Header"), 
    dashboardSidebar(
     sidebarMenu(
     menuItem("Computations", tabName = "tabItem1", icon = icon("dashboard")), 
     menuItem("Results", tabName = "tabItem2", icon = icon("th")) 
    ) 
    ), 

    dashboardBody(
     tabItems(
     tabItem(tabName = "tabItem1", 
      fluidRow(
      box(plotOutput("plot1", height = 250)), 

      box(
       title = "Controls", 
       sliderInput("slider", "Number of observations:", 1, 100, 50) 
      ) 
     ), 
      infoBoxOutput("out1") 
     ), 

     tabItem(tabName = "tabItem2", 
      h2("Widgets tab content") 
     ) 
    ) 
    ) 
) 
) 

server <- function(input, output){ 
    histdata <- rnorm(500) 

    output$plot1 <- renderPlot({ 
    data <- histdata[seq_len(input$slider)] 
    hist(data) 
    }) 

    output$out1 <- renderInfoBox({ 
    infoBox("Completed", 
     a("Computation Completed", onclick = "openTab('tabItem2')"), 
     tags$script(HTML(" 
     var openTab = function(tabName){ 
      $('a', $('.sidebar')).each(function() { 
      if(this.getAttribute('data-value') == tabName) { 
       this.click() 
      }; 
      }); 
     } 
     ")), 
     icon = icon("thumbs-o-up"), color = "green" 
    ) 
    }) 
} 

shinyApp(ui, server) 

注意，这是唯一重要的事情是onclick属性，而不是一个href。这意味着，每个div或其他元素都可用于创建此链接。你甚至可以用这个onclick命令只是竖起大拇指图像。

如果您还有其他问题，请发表评论。

问候

---

编辑：全信息框点击。

这是由OmaymaS发表评论的回答。关键是让infoBox成为一个可点击的容器。为了达到这个目的，我们可以定义一个新的函数，使得infoBox有所不同。自定义文件夹将是如下：

customInfoBox <- function (title, tab = NULL, value = NULL, subtitle = NULL, icon = shiny::icon("bar-chart"), color = "aqua", width = 4, href = NULL, fill = FALSE) { 
    validateColor(color) 
    tagAssert(icon, type = "i") 
    colorClass <- paste0("bg-", color) 
    boxContent <- div(class = "info-box", class = if (fill) colorClass, 
     onclick = if(!is.null(tab)) paste0("$('.sidebar a')).filter(function() { return ($(this).attr('data-value') == ", tab, ")}).click()"), 
     span(class = "info-box-icon", class = if (!fill) colorClass, icon), 
     div(class = "info-box-content", 
      span(class = "info-box-text", title), 
      if (!is.null(value)) span(class = "info-box-number", value), 
      if (!is.null(subtitle)) p(subtitle) 
     ) 
    ) 
    if (!is.null(href)) boxContent <- a(href = href, boxContent) 
    div(class = if (!is.null(width)) paste0("col-sm-", width), boxContent) 
} 

此代码是从原始infoBox函数定义复制并只与onclick行是新的。我还在容器内部添加了openTab函数（带有一些抽搐），以便您不必担心将此函数放在视图中的哪个位置。可能有点超载我的感觉。 此自定义信息框的使用方式与默认信息框完全相同，如果您通过附加的tab参数，则会添加到侧边栏的链接。