Home > front end >  Arrow of menuItem on top of text when creating from list in server - how to remove it? (shinyDashboa
Arrow of menuItem on top of text when creating from list in server - how to remove it? (shinyDashboa

Time:07-19

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 how it looks: shinyApp sidebar screenshot

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)
  • Related