Question

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

我希望在完成计算时动态生成信息框，并使用指向dashboardBody中某个tabItem的链接。

例如，我可以把它放在我的tabItem1输出中，

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

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

谢谢！

更新：除了使用Javascripts之外，在actionLink包中使用updateTabItems和shinydashboard函数看起来也可以正常工作。

Answer 1

我为冗长的代码示例道歉，但我不得不从shinydashboard主页复制tabItems的示例。

你的方法只有很少的问题。首先，如果您要检查menuItems，您会发现实际标签的ID不是tabItem2，而是shiny-tab-tabItem2。这个以及data-toggle="tab"标记中的额外属性a就足以打开所需的标签。片段：

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(
      tags$script(HTML("
        var openTab = function(tabName){
          $('a', $('.sidebar')).each(function() {
            if(this.getAttribute('data-value') == tabName) {
              this.click()
            };
          });
        }
      ")),
      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')", href="#"),
      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参数，则会添加侧栏的链接。

编辑：字幕利用

正如 Alex Dometrius 所提到的，使用subtitle会破坏此功能。这是因为在事故中插入的脚本标记被用作subtitle参数，以便使用该框进行渲染。为了释放这个位置，我在顶部编辑了主要示例，使得脚本标记位于dashboardBody的顶层（字面意思是ui中的任何位置都没问题。）

（为避免混淆：在版本1中，tags$script在infobox内部提供，其中subtitle被解释为position:absolute;参数。）

使用R闪亮仪表板直接链接到tabItem

1 个答案: