Icons not appearing in left menu in navbar / dashboardheaderplus

[McCartneyAC]

I've tried a few different icons so I know the issue isn't with fontAwesome. The icons appear if I add them to the left navbar list, but when I add a left menu dropdown to the header, it appears as title text but without the icon appearing. Am I crazy?

[DivadNojnarg]

Could you show me a REPREX please?

[McCartneyAC]

yep! It's a bit big, but I've preserved minimal functionality just to show the gist. the idea is upload a document, get summary stats, download a report. I'm working on the download report part right now, but the button at the top isn't getting its proper icon.

# Packages ---------------------------------------------------------------

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
library(psych)
library(dplyr)
library(tidyr)
library(tibble)
library(gt)

# functions ---------------------------------------------------------------
is_extant <-function(x) any(!is.na(x))
is_numeric<-function(x) any(is.numeric(x))

# Data import
use <- function(name) {
  # consider future support for .json? 
  if (grepl(".csv", name)) {
    readr::read_csv(name)
  } else if (grepl(".xlsx", name)) {
    readxl::read_xlsx(name)
  } else if (grepl(".dta", name)) {
    haven::read_dta(name)
  } else if (grepl(".sav", name)) {
    haven::read_spss(name)
  } else if (grepl(".rda", name)) {
    load(name)
  } else {
    stop("unknown data type.")
  }
}

# UI components -----------------------------------------------------------
ui <- dashboardPagePlus(
                        dashboardHeaderPlus(title = "ShindashboardPlus Reprex",
                                            left_menu = tagList(
                                              dropdownBlock(
                                                id = "download_dropdown",
                                                title = "Download Report",
                                                #### ERROR WITH ICON HERE
                                                icon = icon("sliders"),
                                                #### SLIDERS ICON DOESN'T APPEAR
                                                #### nor does "download"
                                                radioButtons('format',
                                                             helpText('Document format'),
                                                             c('PDF', 'HTML', 'Word')),
                                                downloadButton('downloadReport'),
                                                badgeStatus = NULL
                                              )
                                            )
                        ),

                        ##  Sidebar -----------------------------------------------------------------
                          dashboardSidebar(
                          sidebarMenu(id = "sidebar",
                                      tags$h4("Your Data:"),
                                      menuItem("Upload", tabName = "reg_upload", icon = icon("upload")),
                                      menuItem("Describe", tabName = "reg_desc", icon = icon("list-ol"))

                          ) # sidebarmenu

                        ), #sidebar 
                        dashboardBody(
                          tags$head(tags$title("Left navbar reprex")),
                          tabItems(

                            ## Data Subsection ---------------------------------------------------------

                            tabItem(tabName = "reg_upload",
                                    box( title = "Upload and Model",width = 7,
                                         fileInput("FileInput", "Input Your Data Set"),
                                         helpText("Dataset must be one of: .csv, .sav, .dta, .xlsx, or .rda")
                                    ), #upload box
                                    box(title = "Your Data", width = 12, 
                                        DT::dataTableOutput("reg_data_table")
                                    ) # box (Dataset output)

                            ), #tabItem (reg upload)

                            # # Describe
                            tabItem(tabName = "reg_desc", title = "Describe",  
                                    box(title = "Data Description", width  = 10,
                                        materialSwitch(
                                          inputId = "ext_desc",
                                          label = "Extended Description", 
                                          value = FALSE,
                                          status = "primary"
                                        ),
                                        # selectInput(
                                        #    inputId = "desc_group",
                                        #    label = "Describe By A Group", 
                                        #    choices = NULL
                                        # ),
                                        gt::gt_output("description"))
                            )
                          ) #tabitems
                        ) #Dashboard Body
) #Dashboard Page

# Server Components -------------------------------------------------------

server <- function(input, output, session) { 

  # Data Input --------------------------------------------------------------

  datasetInput <- reactive({
    infile <- input$FileInput
    if (is.null(infile))
      return(NULL)
    dat<-use(infile$datapath)
    names(dat) <-  gsub(" ", "_", names(dat), fixed = TRUE) 
    return(dat)
  })

  # Describe the Data Set ---------------------------------------------------
  descgroup <- reactive({
    input$desc_group
  })

  desc <- reactive({
    req(datasetInput())
    #desc_formula<- as.formula(substitute(datasetInput()  ~  descgroup()  ))
    #grp<-paste0(deparse(substitute(descgroup()))) 
    datasetInput() %>%
      select_if(is_numeric) %>%
      psych::describe(., fast = !(input$ext_desc)) %>%
      add_rownames(var = "Variable") %>%
      dplyr::select(-c(vars)) %>%
      dplyr::mutate(dplyr::across(is.numeric, round, 2)) %>%
      gt::gt() %>%
      gt::tab_options(
        column_labels.font.size = "small",
        table.font.size = "small",
        row_group.font.size = "small",
        data_row.padding = px(3)
      ) %>%
      gt::tab_header(title = paste0("Data Description"))
  })

  output$description =  gt::render_gt(desc())

  # download report ---------------------------------------------------------
  output$downloadReport <- downloadHandler(
    filename = function() {
      paste('RegressionOutput', sep = '.', switch(
        input$format, "PDF" = 'pdf', "HTML" = 'html', "Word" = 'docx'
      ))
    },
    content = function(file) {
      src <- normalizePath('report.Rmd')
      owd <- setwd(tempdir())
      on.exit(setwd(owd))
      file.copy(src, 'report.Rmd')
      out <- render('report.Rmd', switch(
        input$format,
        PDF = pdf_document(), HTML = html_document(), Word = word_document()
      ))
      file.rename(out, file)
    })

}

shinyApp(ui, server)

[DivadNojnarg]

Thanks. According to the documentation, the icon param of dropdownBlock does not expect the use of shiny::icon("<icon_name>"):

dropdownBlock(
          id = "mydropdown",
          title = "Dropdown 1",
          icon = "sliders",
          sliderInput(
            inputId = "n",
            label = "Number of observations",
            min = 10, max = 100, value = 30
          ),
          prettyToggle(
            inputId = "na",
            label_on = "NAs kept",
            label_off = "NAs removed",
            icon_on = icon("check"),
            icon_off = icon("remove")
          )
        )

I acknowledge this is misleading since shinydashboard uses icon which allows to choose between different libraries (fontawesome, glyphicons, ...).

You could use the custom below function before I decide any action on shinydashboardPlus:

validStatuses <- c("primary", "success", "info", "warning", "danger" )

validateStatus <- function (status) 
{
    if (status %in% validStatuses) {
        return(TRUE)
    }
    stop("Invalid status: ", status, ". Valid statuses are: ", 
        paste(validStatuses, collapse = ", "), ".")
}

dropdownBlock <- function(..., id, icon = NULL, title = NULL, 
                          badgeStatus = "danger") {

  if (!is.null(badgeStatus)) 
    validateStatus(badgeStatus)
  items <- c(list(...))

  # Make sure the items are li tags
  #lapply(items, tagAssert, type = "li")
  # items <- lapply(1:length(items), FUN = function(i) {
  #   item <- items[[i]]
  #   name <- item$name
  #   if (name != "li") {
  #     wrapper <- shiny::tags$li()
  #     item <- shiny::tagAppendChild(wrapper, item)
  #   }
  # })

  dropdownClass <- paste0("dropdown")

  numItems <- length(items)
  if (is.null(badgeStatus)) {
    badge <- NULL
  } else {
    badge <- dashboardLabel(status = badgeStatus, numItems)
  }

  shiny::tags$li(
    shiny::singleton(
      shiny::tags$head(
        # custom javascript so that the dropdown
        #is not hidden when the user click on it
        shiny::tags$script(
          shiny::HTML(
            paste0(
              "$(document).ready(function(){
                $('#", id, "').find('ul').click(function(e){
                  e.stopPropagation();
                });
              });
              "
            )
          )
        )
      )
    ),
    class = dropdownClass,
    id = id,
    shiny::tags$a(
      href = "#",
      class = "dropdown-toggle",
      `data-toggle` = "dropdown",
      icon,
      title, 
      badge
    ),
    shiny::tags$ul(
      class = "dropdown-menu",
      style = "left: 0; right: auto;",
      shiny::tags$li(
        shiny::tags$ul(
          class = "menu",
          shiny::tags$div(
            style = "margin-left: auto; margin-right: auto; width: 80%;",
            items
          )
        )
      )
    )
  )
}

[McCartneyAC]

Oh! my apologies. Thanks for the catch.

[McCartneyAC]

Hmm, removing the icon function and just having the name of the icon in "quotes" doesn't appear to solve the issue.

[DivadNojnarg]

If you use the function I gave you above, you can still use your previous code.

[McCartneyAC]

!! okay got it. thank you.