使用 R shiny 仪表板将 link 定向到 tabItem
Direct link to tabItem with R shiny dashboard
我正在使用闪亮的仪表板模板生成我的网站 UI。
我想在计算完成时动态生成一个信息框,link 指向 dashboardBody
中的一个选项卡项。
例如,
我可以把它放在我的 tabItem1
输出中,
renderInfoBox({
infoBox("Completed",
a("Computation Completed", href="#tabItem2"),
icon = icon("thumbs-o-up"), color = "green"
)
})
但问题是当我点击 link 时,它没有任何反应。我希望它跳转到 tabItem2
。当我将鼠标悬停在 link href 上时,它似乎有效。
谢谢!
更新:
除了使用 Javascripts 之外,看起来使用 shinydashboard
包中的 actionLink
和 updateTabItems
函数也可以。
对于冗长的代码示例,我深表歉意,但我不得不从 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
或其他元素都可用于创建此 link。您甚至可以使用此 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
参数,则会将 link 添加到侧边栏。
编辑:字幕利用
正如 Alex Dometrius 提到的,使用 subtitle
会导致此功能崩溃。这是因为意外插入的脚本标记被用作 subtitle
参数以便与框一起呈现。为了腾出这个位置,我在顶部编辑了主要示例,使脚本标签位于 dashboardBody
的顶层(字面意思是 ui 中的任何位置都可以)。
(为避免混淆:在版本 1 中,tags$script
在 infobox
内部提供,它被解释为 subtitle
参数。)
我正在使用闪亮的仪表板模板生成我的网站 UI。
我想在计算完成时动态生成一个信息框,link 指向 dashboardBody
中的一个选项卡项。
例如,
我可以把它放在我的 tabItem1
输出中,
renderInfoBox({
infoBox("Completed",
a("Computation Completed", href="#tabItem2"),
icon = icon("thumbs-o-up"), color = "green"
)
})
但问题是当我点击 link 时,它没有任何反应。我希望它跳转到 tabItem2
。当我将鼠标悬停在 link href 上时,它似乎有效。
谢谢!
更新:
除了使用 Javascripts 之外,看起来使用 shinydashboard
包中的 actionLink
和 updateTabItems
函数也可以。
对于冗长的代码示例,我深表歉意,但我不得不从 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
或其他元素都可用于创建此 link。您甚至可以使用此 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
参数,则会将 link 添加到侧边栏。
编辑:字幕利用
正如 Alex Dometrius 提到的,使用 subtitle
会导致此功能崩溃。这是因为意外插入的脚本标记被用作 subtitle
参数以便与框一起呈现。为了腾出这个位置,我在顶部编辑了主要示例,使脚本标签位于 dashboardBody
的顶层(字面意思是 ui 中的任何位置都可以)。
(为避免混淆:在版本 1 中,tags$script
在 infobox
内部提供,它被解释为 subtitle
参数。)