本文介绍了直接链接到带有R闪亮仪表板的选项卡项的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

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

我希望在使用指向dashboardBody中的一个表项的链接完成计算时动态生成信息箱。

例如,我可以将其放入tabItem1输出中,

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

但问题是,当我单击该链接时,它什么也不做。我希望它跳到tabItem2。当我将鼠标悬停在上面时,链接HREF似乎有效。

谢谢!


更新:除了使用JavaScripts之外,似乎使用shinydashboard包中的actionLinkupdateTabItems函数也可以。

推荐答案

我为冗长的代码示例道歉,但我不得不从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(
      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评论的答复。重点是让信息箱成为一个可点击的容器。要实现这一点,可以定义一个新函数来创建稍有不同的信息箱。自定义框如下所示:

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 Dimrius提到的,使用subtitle会使此功能崩溃。这是因为意外插入的脚本标记被用作subtitle参数,以便与框一起呈现。为了腾出这个位置,我向上编辑了主示例,使脚本标记位于dashboardBody中的顶层(从字面上看,在UI中的任何位置都可以)。

(避免念力:在版本1中,tags$script提供在infobox内部,解释为subtitle参数。)

这篇关于直接链接到带有R闪亮仪表板的选项卡项的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!

07-22 23:12