在 shinyDashboard 中的 menuSubItems 之间切换
Switching between menuSubItems in shinyDashboard
我正在尝试使用 shinydashboard 设置一个闪亮的应用程序,在大多数情况下,祝你好运。但是,我 运行 对侧边栏行为感到怪异,我认为这是可以避免的,但还没有找到如何避免的。
下面是一个重现我遇到的问题的小例子。基本上,有两个 sidebarMenus - 菜单一和菜单二,每个都有两个 menuSubItems。在菜单项中切换子项工作正常。所以,如果我想从 subItemOne 切换到 subItemTwo,没问题。我可以整天这样做。
我还可以跨菜单切换到子项,例如从 subItemOne 跳到 subItemThree,这很好。问题在于试图切换回来。如果选择了 subItemOne,我尝试转到 subItemThree 并返回 到 subItemOne,我做不到。我必须转到 subItemTwo,然后才能打开 SubItemOne。
有没有办法更正此设置,以便我可以直接从 subItemOne 跳到 subItemThree(或二和四)然后再返回?
library('shiny')
library('shinydashboard')
# Sidebar #############################
sidebar <- dashboardSidebar(
width = 290,
sidebarMenu(
menuItem('Menu One', tabName = 'menuOne', icon = icon('line-chart'),
collapsible =
menuSubItem('Sub-Item One', tabName = 'subItemOne'),
menuSubItem('Sub-Item Two', tabName = 'subItemTwo')
)
),
sidebarMenu(
menuItem('Menu Two', tabName = 'menuTwo', icon = icon('users'),
collapsible =
menuSubItem('Sub-Item Three', tabName = 'subItemThree'),
menuSubItem('Sub-Item Four', tabName = 'subItemFour')
)
)
)
# Body #############################
body <- dashboardBody(
tabItems(
tabItem(tabName = 'subItemOne',
h2('Selected Sub-Item One')
),
tabItem(tabName = 'subItemTwo',
h2('Selected Sub-Item Two')
),
tabItem(tabName = 'subItemThree',
h2('Selected Sub-Item Three')
),
tabItem(tabName = 'subItemFour',
h2('Selected Sub-Item Four')
)
)
)
# UI #############################
ui <- dashboardPage(
dashboardHeader(title = 'Test', titleWidth = 290),
sidebar,
body
)
# Server #############################
server <- function(input, output){
}
shinyApp(ui, server)
问题是选项卡项目保持活动状态,单击活动选项卡项目不会更新 UI。这可以用一些 Javascript.
来解决
library('shiny')
library('shinydashboard')
# Sidebar #############################
sidebar <- dashboardSidebar(
tags$head(
tags$script(
HTML(
"
$(document).ready(function(){
// Bind classes to menu items, easiet to fill in manually
var ids = ['subItemOne','subItemTwo','subItemThree','subItemFour'];
for(i=0; i<ids.length; i++){
$('a[data-value='+ids[i]+']').addClass('my_subitem_class');
}
// Register click handeler
$('.my_subitem_class').on('click',function(){
// Unactive menuSubItems
$('.my_subitem_class').parent().removeClass('active');
})
})
"
)
)
),
width = 290,
sidebarMenu(
menuItem('Menu One', tabName = 'menuOne', icon = icon('line-chart'),
collapsible =
menuSubItem('Sub-Item One', tabName = 'subItemOne'),
menuSubItem('Sub-Item Two', tabName = 'subItemTwo')
)
),
sidebarMenu(
menuItem('Menu Two', tabName = 'menuTwo', icon = icon('users'),
collapsible =
menuSubItem('Sub-Item Three', tabName = 'subItemThree'),
menuSubItem('Sub-Item Four', tabName = 'subItemFour')
)
)
)
# Body #############################
body <- dashboardBody(
tabItems(
tabItem(tabName = 'subItemOne',
h2('Selected Sub-Item One')
),
tabItem(tabName = 'subItemTwo',
h2('Selected Sub-Item Two')
),
tabItem(tabName = 'subItemThree',
h2('Selected Sub-Item Three')
),
tabItem(tabName = 'subItemFour',
h2('Selected Sub-Item Four')
)
)
)
# UI #############################
ui <- dashboardPage(
dashboardHeader(title = 'Test', titleWidth = 290),
sidebar,
body
)
# Server #############################
server <- function(input, output){
}
shinyApp(ui, server)
我正在尝试使用 shinydashboard 设置一个闪亮的应用程序,在大多数情况下,祝你好运。但是,我 运行 对侧边栏行为感到怪异,我认为这是可以避免的,但还没有找到如何避免的。
下面是一个重现我遇到的问题的小例子。基本上,有两个 sidebarMenus - 菜单一和菜单二,每个都有两个 menuSubItems。在菜单项中切换子项工作正常。所以,如果我想从 subItemOne 切换到 subItemTwo,没问题。我可以整天这样做。
我还可以跨菜单切换到子项,例如从 subItemOne 跳到 subItemThree,这很好。问题在于试图切换回来。如果选择了 subItemOne,我尝试转到 subItemThree 并返回 到 subItemOne,我做不到。我必须转到 subItemTwo,然后才能打开 SubItemOne。
有没有办法更正此设置,以便我可以直接从 subItemOne 跳到 subItemThree(或二和四)然后再返回?
library('shiny')
library('shinydashboard')
# Sidebar #############################
sidebar <- dashboardSidebar(
width = 290,
sidebarMenu(
menuItem('Menu One', tabName = 'menuOne', icon = icon('line-chart'),
collapsible =
menuSubItem('Sub-Item One', tabName = 'subItemOne'),
menuSubItem('Sub-Item Two', tabName = 'subItemTwo')
)
),
sidebarMenu(
menuItem('Menu Two', tabName = 'menuTwo', icon = icon('users'),
collapsible =
menuSubItem('Sub-Item Three', tabName = 'subItemThree'),
menuSubItem('Sub-Item Four', tabName = 'subItemFour')
)
)
)
# Body #############################
body <- dashboardBody(
tabItems(
tabItem(tabName = 'subItemOne',
h2('Selected Sub-Item One')
),
tabItem(tabName = 'subItemTwo',
h2('Selected Sub-Item Two')
),
tabItem(tabName = 'subItemThree',
h2('Selected Sub-Item Three')
),
tabItem(tabName = 'subItemFour',
h2('Selected Sub-Item Four')
)
)
)
# UI #############################
ui <- dashboardPage(
dashboardHeader(title = 'Test', titleWidth = 290),
sidebar,
body
)
# Server #############################
server <- function(input, output){
}
shinyApp(ui, server)
问题是选项卡项目保持活动状态,单击活动选项卡项目不会更新 UI。这可以用一些 Javascript.
来解决library('shiny')
library('shinydashboard')
# Sidebar #############################
sidebar <- dashboardSidebar(
tags$head(
tags$script(
HTML(
"
$(document).ready(function(){
// Bind classes to menu items, easiet to fill in manually
var ids = ['subItemOne','subItemTwo','subItemThree','subItemFour'];
for(i=0; i<ids.length; i++){
$('a[data-value='+ids[i]+']').addClass('my_subitem_class');
}
// Register click handeler
$('.my_subitem_class').on('click',function(){
// Unactive menuSubItems
$('.my_subitem_class').parent().removeClass('active');
})
})
"
)
)
),
width = 290,
sidebarMenu(
menuItem('Menu One', tabName = 'menuOne', icon = icon('line-chart'),
collapsible =
menuSubItem('Sub-Item One', tabName = 'subItemOne'),
menuSubItem('Sub-Item Two', tabName = 'subItemTwo')
)
),
sidebarMenu(
menuItem('Menu Two', tabName = 'menuTwo', icon = icon('users'),
collapsible =
menuSubItem('Sub-Item Three', tabName = 'subItemThree'),
menuSubItem('Sub-Item Four', tabName = 'subItemFour')
)
)
)
# Body #############################
body <- dashboardBody(
tabItems(
tabItem(tabName = 'subItemOne',
h2('Selected Sub-Item One')
),
tabItem(tabName = 'subItemTwo',
h2('Selected Sub-Item Two')
),
tabItem(tabName = 'subItemThree',
h2('Selected Sub-Item Three')
),
tabItem(tabName = 'subItemFour',
h2('Selected Sub-Item Four')
)
)
)
# UI #############################
ui <- dashboardPage(
dashboardHeader(title = 'Test', titleWidth = 290),
sidebar,
body
)
# Server #############################
server <- function(input, output){
}
shinyApp(ui, server)