问题
Is there a way of actually showing content in the content pane of a Shiny Dashboard for a menuItem with existing menuSubItems. In the example: I tried to add "tabName = "charts"" to the menuItem "Charts" in order to show the content of tabItem "charts". However, no effect besides opening the menu and showing the submenu (the content pane still shows the "old" content of the previous selection):
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)
回答1:
Much credit goes to this question React to menuItem() tab selection
. The only this that is a bit annoying is you have to click again on the Charts tab but I think thats fine
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) { }
)
来源：https://stackoverflow.com/questions/48210709/show-content-for-menuitem-when-menusubitems-exist-in-shiny-dashboard