I am creating a shiny dashboard app where part of the sidebar is generated automatically when adding some inputs. When the menuItems are created inside a list in a server function, the default arrow that should be next to the text is actually on top. I have tried some CSS to remove it but I don't know much and of course it doesn't work.
/* Hide icons in sub-menu items */
.sidebar .sidebar-menu .treeview-menu>li>a>.fa {
display: none;
}
This is the code used:
ui.R :
shinyUI(dashboardPage(
dashboardSidebar(
width = 400,
sidebarMenu(
menuItem('Annotations', icon = icon('pencil-alt'),
uiOutput('annot')
)
)#end of menu
)#end of sidebar
)) #end of shinyUI
server.R :
##Create inputs for annotations
output$annot <- renderUI({
nclones <- 3 ##this changes (input) but for the example it is enough
cloneLabs <- c('A','B','C') ##this changes (input) but for the example it is enough
lapply(1:(nclones), function(i) {
list(menuItem(paste('Clone',cloneLabs[i]),
textInput(paste0('annot',i),
paste('Annotations',cloneLabs[i])),
switchInput(paste0("col",i), "Text color", labelWidth = "80px",
onLabel = 'White', offLabel = 'Black',
onStatus = 'default'
) #end of menuItem
) #end of list
}) #end of lapply
}) # end of renderUI
CodePudding user response:
Please check shinydashboard's capabilities on dynamic content.
The problem with renderUI
in this case is, that it creates a div
tag. However, for the menuItems we need to create a li
tag. This is what renderMenu
does.
library(shiny)
library(shinyWidgets)
library(shinydashboard)
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(width = 400,
sidebarMenu(
menuItem('Annotations', icon = icon('pencil-alt'),
menuItemOutput('annot'))
)),
dashboardBody())
server <- function(input, output, session) {
##Create inputs for annotations
output$annot <- renderMenu({
nclones <- 3 ##this changes (input) but for the example it is enough
cloneLabs <- c('A', 'B', 'C') ##this changes (input) but for the example it is enough
sidebarMenu(
lapply(1:(nclones), function(i) {
menuItem(
paste('Clone', cloneLabs[i]),
textInput(paste0('annot', i),
paste('Annotations', cloneLabs[i])),
switchInput(
paste0("col", i),
"Text color",
labelWidth = "80px",
onLabel = 'White',
offLabel = 'Black',
onStatus = 'default'
)
) # end of menuItem
}) # end of lapply
) # end of sidebarMenu
}) # end of renderMenu
}
shinyApp(ui, server)
CodePudding user response:
This solution has a different UI effect, but follows the same principle as @ismirsehregal--get rid of the div automatically generated by renderUI()
. It uses insertUI()
instead.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- shinyUI(dashboardPage(
dashboardHeader(),
dashboardSidebar(
width = 400,
sidebarMenu(
menuItem('Annotations', icon = icon('pencil-alt'),
span(id ="annot"))
)#end of menu
),#end of sidebar
dashboardBody()
)) #end of shinyUI
server <- function(input, output) {
##Create inputs for annotations
make_menu <- function() {
nclones <- 3 ##this changes (input) but for the example it is enough
cloneLabs <- c('A','B','C') ##this changes (input) but for the example it is enough
menu_bundle <- lapply(1:(nclones), function(i) {
menuItem(paste('Clone',cloneLabs[i]),
textInput(paste0('annot',i),
paste('Annotations',cloneLabs[i])),
switchInput(paste0("col",i), "Text color", labelWidth = "80px",
onLabel = 'White', offLabel = 'Black',
onStatus = 'default'
) #end of menuItem
) #end of list
}) #end of lapply
insertUI(
selector = "#annot",
where = "afterEnd",
ui = menu_bundle
)
} # end of renderUI
make_menu()
}
shinyApp(ui, server)