当 menuSubItems 存在于 Shiny Dashboard 时显示 menuItem 的内容
Show content for menuItem when menuSubItems exist in Shiny Dashboard
有没有一种方法可以在 Shiny Dashboard 的内容窗格中为具有现有 menuSubItem 的 menuItem 实际显示内容。在示例中：我尝试将 "tabName = "charts"" 添加到 menuItem "Charts" 以显示 tabItem "charts" 的内容。但是，除了打开菜单和显示子菜单外没有任何效果（内容面板仍然显示之前选择的 "old" 内容）：
header <- dashboardHeader()
#> Error in dashboardHeader(): konnte Funktion "dashboardHeader" nicht finden
sidebar <- dashboardSidebar(
sidebarUserPanel("User Name",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
# Image file should be in www/ subdir
image = "userimage.png"
),
sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new",
badgeColor = "green"),
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
)
)
)
#> Error in dashboardSidebar(sidebarUserPanel("User Name", subtitle = a(href = "#", : konnte Funktion "dashboardSidebar" nicht finden
body <- dashboardBody(
tabItems(
tabItem("dashboard",
div(p("Dashboard tab content"))
),
tabItem("widgets",
"Widgets tab content"
),
tabItem("subitem1",
"Sub-item 1 tab content"
),
tabItem("subitem2",
"Sub-item 2 tab content"
)
)
)
#> Error in dashboardBody(tabItems(tabItem("dashboard", div(p("Dashboard tab content"))), : konnte Funktion "dashboardBody" nicht finden
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
#> Error in shinyApp(ui = dashboardPage(header, sidebar, body), server = function(input, : konnte Funktion "shinyApp" nicht finden
devtools::session_info()
#> Session info -------------------------------------------------------------
#> setting value
#> version R version 3.4.0 (2017-04-21)
#> system x86_64, mingw32
#> ui RTerm
#> language (EN)
#> collate German_Germany.1252
#> tz Europe/Berlin
#> date 2018-01-11
#> Packages -----------------------------------------------------------------
#> package * version date source
#> backports 1.1.0 2017-05-22 CRAN (R 3.4.0)
#> base * 3.4.0 2017-04-21 local
#> compiler 3.4.0 2017-04-21 local
#> datasets * 3.4.0 2017-04-21 local
#> devtools 1.13.3 2017-08-02 CRAN (R 3.4.1)
#> digest 0.6.13 2017-12-14 CRAN (R 3.4.3)
#> evaluate 0.10.1 2017-06-24 CRAN (R 3.4.1)
#> graphics * 3.4.0 2017-04-21 local
#> grDevices * 3.4.0 2017-04-21 local
#> htmltools 0.3.6 2017-04-28 CRAN (R 3.4.0)
#> knitr 1.17 2017-08-10 CRAN (R 3.4.1)
#> magrittr 1.5 2014-11-22 CRAN (R 3.4.0)
#> memoise 1.1.0 2017-04-21 CRAN (R 3.4.0)
#> methods * 3.4.0 2017-04-21 local
#> Rcpp 0.12.14 2017-11-23 CRAN (R 3.4.3)
#> rmarkdown 1.6 2017-06-15 CRAN (R 3.4.0)
#> rprojroot 1.2 2017-01-16 CRAN (R 3.4.0)
#> stats * 3.4.0 2017-04-21 local
#> stringi 1.1.5 2017-04-07 CRAN (R 3.4.0)
#> stringr 1.2.0 2017-02-18 CRAN (R 3.4.0)
#> tools 3.4.0 2017-04-21 local
#> utils * 3.4.0 2017-04-21 local
#> withr 2.1.1.9000 2018-01-05 Github (jimhester/withr@df18523)
#> yaml 2.1.14 2016-11-12 CRAN (R 3.4.0)
很多功劳归功于这个问题对 menuItem() 选项卡选择做出反应
。唯一烦人的是您必须再次单击 Charts 选项卡，但我认为应该没问题
library(shiny)
library(shinydashboard)
convertMenuItem <- function(mi,tabName) {
mi$children[[1]]$attribs['data-toggle']="tab"
mi$children[[1]]$attribs['data-value'] = tabName
if(length(mi$attribs$class)>0 && mi$attribs$class=="treeview"){
mi$attribs$class=NULL
}
mi
}
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarUserPanel("Pork Chop",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
# Image file should be in www/ subdir
image = "https://vignette.wikia.nocookie.net/fanfictiondisney/images/9/9e/Pumba_3.jpg/revision/latest?cb=20120708163413"
),
sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new", badgeColor = "green"),
convertMenuItem(menuItem("Charts", tabName = "charts",icon = icon("bar-chart-o"),selected=T,
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")),"charts")
)
)
body <- dashboardBody(
tabItems(
tabItem("dashboard",div(p("Dashboard tab content"))),
tabItem("widgets","Widgets tab content"),
tabItem("charts","Charts Tab"),
tabItem("subitem1","Sub-item 1 tab content"),
tabItem("subitem2","Sub-item 2 tab content")
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
来自 here. This is an alternative approach showing a hidden, childless menuItem 与 tabItem 相关联，一旦孩子 menuItem 展开。
与@PorkChop 当前解决方案相比的两个优点是，input$sidebarItemExpanded 仍然有效（使用 convertMenuItem 时不会更新）并且无需第二次单击即可展开菜单。
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets"),
menuItem("Charts", id = "chartsID", tabName = "charts", icon = icon("bar-chart-o"), expandedName = "CHARTS",
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
),
hidden(menuItem("hiddenCharts", tabName = "hiddenCharts"))
)
),
dashboardBody(
useShinyjs(),
tabItems(
tabItem("dashboard", "Dashboard tab content"),
tabItem("widgets", "Widgets tab content"),
tabItem("hiddenCharts", "Charts Tab"),
tabItem("subitem1", "Sub-item 1 tab content"),
tabItem("subitem2", "Sub-item 2 tab content")
)
)
)
server <- function(input, output, session) {
observeEvent(input$sidebarItemExpanded, {
if(input$sidebarItemExpanded == "CHARTS"){
updateTabItems(session, "sidebarID", selected = "hiddenCharts")
}
})
}
shinyApp(ui, server)
有没有一种方法可以在 Shiny Dashboard 的内容窗格中为具有现有 menuSubItem 的 menuItem 实际显示内容。在示例中：我尝试将 "tabName = "charts"" 添加到 menuItem "Charts" 以显示 tabItem "charts" 的内容。但是，除了打开菜单和显示子菜单外没有任何效果（内容面板仍然显示之前选择的 "old" 内容）：
header <- dashboardHeader()
#> Error in dashboardHeader(): konnte Funktion "dashboardHeader" nicht finden
sidebar <- dashboardSidebar(
sidebarUserPanel("User Name",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
# Image file should be in www/ subdir
image = "userimage.png"
),
sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new",
badgeColor = "green"),
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
)
)
)
#> Error in dashboardSidebar(sidebarUserPanel("User Name", subtitle = a(href = "#", : konnte Funktion "dashboardSidebar" nicht finden
body <- dashboardBody(
tabItems(
tabItem("dashboard",
div(p("Dashboard tab content"))
),
tabItem("widgets",
"Widgets tab content"
),
tabItem("subitem1",
"Sub-item 1 tab content"
),
tabItem("subitem2",
"Sub-item 2 tab content"
)
)
)
#> Error in dashboardBody(tabItems(tabItem("dashboard", div(p("Dashboard tab content"))), : konnte Funktion "dashboardBody" nicht finden
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
#> Error in shinyApp(ui = dashboardPage(header, sidebar, body), server = function(input, : konnte Funktion "shinyApp" nicht finden
devtools::session_info()
#> Session info -------------------------------------------------------------
#> setting value
#> version R version 3.4.0 (2017-04-21)
#> system x86_64, mingw32
#> ui RTerm
#> language (EN)
#> collate German_Germany.1252
#> tz Europe/Berlin
#> date 2018-01-11
#> Packages -----------------------------------------------------------------
#> package * version date source
#> backports 1.1.0 2017-05-22 CRAN (R 3.4.0)
#> base * 3.4.0 2017-04-21 local
#> compiler 3.4.0 2017-04-21 local
#> datasets * 3.4.0 2017-04-21 local
#> devtools 1.13.3 2017-08-02 CRAN (R 3.4.1)
#> digest 0.6.13 2017-12-14 CRAN (R 3.4.3)
#> evaluate 0.10.1 2017-06-24 CRAN (R 3.4.1)
#> graphics * 3.4.0 2017-04-21 local
#> grDevices * 3.4.0 2017-04-21 local
#> htmltools 0.3.6 2017-04-28 CRAN (R 3.4.0)
#> knitr 1.17 2017-08-10 CRAN (R 3.4.1)
#> magrittr 1.5 2014-11-22 CRAN (R 3.4.0)
#> memoise 1.1.0 2017-04-21 CRAN (R 3.4.0)
#> methods * 3.4.0 2017-04-21 local
#> Rcpp 0.12.14 2017-11-23 CRAN (R 3.4.3)
#> rmarkdown 1.6 2017-06-15 CRAN (R 3.4.0)
#> rprojroot 1.2 2017-01-16 CRAN (R 3.4.0)
#> stats * 3.4.0 2017-04-21 local
#> stringi 1.1.5 2017-04-07 CRAN (R 3.4.0)
#> stringr 1.2.0 2017-02-18 CRAN (R 3.4.0)
#> tools 3.4.0 2017-04-21 local
#> utils * 3.4.0 2017-04-21 local
#> withr 2.1.1.9000 2018-01-05 Github (jimhester/withr@df18523)
#> yaml 2.1.14 2016-11-12 CRAN (R 3.4.0)
很多功劳归功于这个问题对 menuItem() 选项卡选择做出反应
。唯一烦人的是您必须再次单击 Charts 选项卡，但我认为应该没问题
library(shiny)
library(shinydashboard)
convertMenuItem <- function(mi,tabName) {
mi$children[[1]]$attribs['data-toggle']="tab"
mi$children[[1]]$attribs['data-value'] = tabName
if(length(mi$attribs$class)>0 && mi$attribs$class=="treeview"){
mi$attribs$class=NULL
}
mi
}
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarUserPanel("Pork Chop",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
# Image file should be in www/ subdir
image = "https://vignette.wikia.nocookie.net/fanfictiondisney/images/9/9e/Pumba_3.jpg/revision/latest?cb=20120708163413"
),
sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new", badgeColor = "green"),
convertMenuItem(menuItem("Charts", tabName = "charts",icon = icon("bar-chart-o"),selected=T,
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")),"charts")
)
)
body <- dashboardBody(
tabItems(
tabItem("dashboard",div(p("Dashboard tab content"))),
tabItem("widgets","Widgets tab content"),
tabItem("charts","Charts Tab"),
tabItem("subitem1","Sub-item 1 tab content"),
tabItem("subitem2","Sub-item 2 tab content")
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
来自 here. This is an alternative approach showing a hidden, childless menuItem 与 tabItem 相关联，一旦孩子 menuItem 展开。
与@PorkChop 当前解决方案相比的两个优点是，input$sidebarItemExpanded 仍然有效（使用 convertMenuItem 时不会更新）并且无需第二次单击即可展开菜单。
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets"),
menuItem("Charts", id = "chartsID", tabName = "charts", icon = icon("bar-chart-o"), expandedName = "CHARTS",
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
),
hidden(menuItem("hiddenCharts", tabName = "hiddenCharts"))
)
),
dashboardBody(
useShinyjs(),
tabItems(
tabItem("dashboard", "Dashboard tab content"),
tabItem("widgets", "Widgets tab content"),
tabItem("hiddenCharts", "Charts Tab"),
tabItem("subitem1", "Sub-item 1 tab content"),
tabItem("subitem2", "Sub-item 2 tab content")
)
)
)
server <- function(input, output, session) {
observeEvent(input$sidebarItemExpanded, {
if(input$sidebarItemExpanded == "CHARTS"){
updateTabItems(session, "sidebarID", selected = "hiddenCharts")
}
})
}
shinyApp(ui, server)
