18 Template skeleton

The list of all available layouts is quite impressive (horizontal, vertical, compressed, right to left, dark, …). In the next steps, we focus on the dark-compressed template, leaving the reader to try other templates as an exercise.

18.1 Identify template elements

We are quite lucky since there is nothing fancy about the tabler layout. As usual, let’s inspect the layout-condensed-dark.html (located /demo folder) on Figure 18.1

Tabler condensed layout

FIGURE 18.1: Tabler condensed layout

There are two main components:

  • the header containing the brand logo, the navigation and dropdown
  • the content containing the dashboard body as well as the footer

The dashboard body does not mean <body> tag!

This is all!

18.2 Design the page layout

18.2.1 The page wrapper

Do you remember the structure of a basic HTML page seen in Chapter 1.2? Well, if not, here is a reminder.

<!DOCTYPE HTML>
<html lang="en">
  <head>
  <!-- head content here -->
    <title>A title</title>
  </head>
  <body>
  <!-- body content here -->
  </body>
</html>

We actually don’t need to include the <html> tag since shiny does it on the fly, as described in details in chapter 5.7.1. Below we construct a list of tags with tagList(), including the head and the body. In the head we have the meta tags which has multiple purposes:

  • Describe the encoding.
  • How to display the app on different devices. For instance apple-mobile-web-app-status-bar-style is for iOS devices mobile support.
  • Set the favicon, which is an icon representing the website icon, that is the one you may see on the right side of the searchbar. Try twitter for instance.

The page title and favicon may be changed by the developer, so they may be included as function parameters. If you remember, there also should be CSS in the head but nothing here! Actually, the insertion of dependencies is be achieved by our very own add_tabler_deps() function defined in Chapter 17. Tabler comes with two main themes, namely white and dark, which may be applied through the <body> class attribute (respectively antialiased theme-dark and antialiased). The parameter contains other template elements like the header and the dashboard body, that remains to be designed. As shown in Figure 16.1 of Chapter 16, the tabler dashboard template may contain a navigation bar as well as a footer. As they are not mandatory, we don’t create dedicated parameters and pass all elements in the ... slot:

tabler_page <- function(..., dark = TRUE, title = NULL, favicon = NULL){
  
  # head
  head_tag <- tags$head(
    tags$meta(charset = "utf-8"),
    tags$meta(
      name = "viewport", 
      content = "
        width=device-width, 
        initial-scale=1, 
        viewport-fit=cover"
    ),
    tags$meta(`http-equiv` = "X-UA-Compatible", content = "ie=edge"),
    tags$title(title),
    tags$link(
      rel = "preconnect", 
      href = "https://fonts.gstatic.com/", 
      crossorigin = NA
    ),
    tags$meta(name = "msapplication-TileColor", content = "#206bc4"),
    tags$meta(name = "theme-color", content = "#206bc4"),
    tags$meta(name = "apple-mobile-web-app-status-bar-style", content = "black-translucent"),
    tags$meta(name = "apple-mobile-web-app-capable", content = "yes"),
    tags$meta(name = "mobile-web-app-capable", content = "yes"),
    tags$meta(name = "HandheldFriendly", content = "True"),
    tags$meta(name = "MobileOptimized", content = "320"),
    tags$meta(name = "robots", content = "noindex,nofollow,noarchive"),
    tags$link(rel = "icon", href = favicon, type = "image/x-icon"),
    tags$link(rel = "shortcut icon", href = favicon, type="image/x-icon")
  )
  
  # body
  body_tag <- tags$body(
    tags$div(
      class = paste0("antialiased ", if(dark) "theme-dark"),
      style = "display: block;",
      tags$div(class = "page", ...)
    )
  ) %>% add_tabler_deps()
  
  tagList(head_tag, body_tag)
}

Below we quickly test if a tabler element renders well, to confirms whether our setup is adequate. To do this, we include a random tabler element taken from the demo HTML page, using HTML().

Let’s be clear: this is only for testing purposes! In production, you should avoid this as much as possible because of security issues and the bad readability of the code.

This also checks that our basic Shiny input/output system works as expected with a sliderInput() linked to a plotOutput. We finally leverage the thematic package so that plot and template background match:

library(shiny)
library(thematic)

thematic_shiny()

ui <- tabler_page(
  "test", 
  sliderInput("obs", "Number of observations:",
              min = 0, max = 1000, value = 500
  ),
  plotOutput("distPlot"),
  br(),
  HTML(
    [2004 chars quoted with ''']
  ),
title = "Tabler test"
)
server <- function(input, output) {
  output$distPlot <- renderPlot({
    hist(rnorm(input$obs))
  })
}
shinyApp(ui, server)

Ok, our info card and the shiny element work like a charm, which is a good start. Now we may focus on the aesthetics.

18.2.2 The body content

In this part, we translate the dashboard body HTML code to R. As a reminder, the html2r by Alan Dipert substantially speeds up the conversion process. You copy the code in the HTML text area, click on convert and get the R shiny output. We create a function called tabler_body(). The parameter holds all the dashboard body elements and the footer is dedicated for the future tabler_footer() function.

tabler_body <- function(..., footer = NULL) {
  div(
    class = "content",
    div(class = "container-xl", ...),
    tags$footer(class = "footer footer-transparent", footer)
  )
}

Let’s test it with the previous example.

ui <- tabler_page(tabler_body(h1("Hello World")))
server <- function(input, output) {}
shinyApp(ui, server)

Way better!

18.2.4 The navbar (or header)

This function is called tabler_header(). In the Tabler template, the header has the navbar navbar-expand-md navbar-light classes. We don’t need the navbar-light class since we are only interested in the dark theme. As shown on Figure 18.2, the header is composed of four elements:

  • The navbar toggler is only visible when we reduce the screen width, like on mobile devices.
  • The brand image
  • The navigation menu.
  • The dropdown menus (this is not mandatory).
Tabler header structure

FIGURE 18.2: Tabler header structure

You may have a look at the Bootstrap 4 documentation for extra configuration and layout.

Each of these element will be considered as a parameter to the tabler_navbar() function, except the navbar toggler which is a default element and must not be removed. Morever, we only show the brand element when it is provided. The parameter is a slot for extra elements (between the menu and dropdowns). In the following, we start by creating the main container, that is header_tag and its unique child container_tag. The latter has four children toggler_tag, brand_tag, dropdown_tag and navmenu_tag. In this situations, htmltools functions like tagAppendChild() and tagAppendChildren() are game changers to better organize the code and make it more maintainable. One never knows in advance how much extra feature will be added to that component. Hence being cautious at the very beginning is crucial!

tabler_navbar <- function(..., brand_url = NULL, brand_image = NULL, 
                          nav_menu, nav_right = NULL) {
  
  header_tag <- tags$header(class = "navbar navbar-expand-md")
  container_tag <- tags$div(class = "container-xl")
  
  # toggler for small devices (must not be removed)
  toggler_tag <- tags$button(
    class = "navbar-toggler", 
    type = "button", 
    `data-toggle` = "collapse", 
    `data-target` = "#navbar-menu",
    span(class = "navbar-toggler-icon")
  )
  
  # brand elements
  brand_tag <- if (!is.null(brand_url) || !is.null(brand_image)) {
    a(
      href = if (!is.null(brand_url)) {
        brand_url
      } else {
        "#"
      },
      class = "navbar-brand navbar-brand-autodark 
      d-none-navbar-horizontal pr-0 pr-md-3",
      if(!is.null(brand_image)) {
        img(
          src = brand_image, 
          alt = "brand Image",
          class = "navbar-brand-image"
        )
      }
    )
  }
  
  dropdown_tag <- if (!is.null(nav_right)) {
    div(class = "navbar-nav flex-row order-md-last", nav_right)
  }
  
  navmenu_tag <- div(
    class = "collapse navbar-collapse", 
    id = "navbar-menu",
    div(
      class = "d-flex flex-column flex-md-row flex-fill 
      align-items-stretch align-items-md-center",
      nav_menu
    ),
    if (length(list(...)) > 0) {
      div(
        class = "ml-md-auto pl-md-4 py-2 py-md-0 mr-md-4 
        order-first order-md-last flex-grow-1 flex-md-grow-0", 
        ...
      )
    }
  )
  
  container_tag <- container_tag %>% tagAppendChildren(
    toggler_tag,
    brand_tag,
    dropdown_tag,
    navmenu_tag
  )
  
  header_tag %>% tagAppendChild(container_tag)
  
}

The navbar menu is the main navbar component. The parameter is a slot for the menu items. Compared to the original tabler dashboard template where there is only the navbar-nav class, we have to add at least, the nav class to make sure items are correctly activated/inactivated. The nav-pills class is to select pills instead of basic tabs (see here), which is nothing more than a cosmetic consideration. Notice the ul tag that will contain li elements, that is the navbar items:

tabler_navbar_menu <- function(...) {
  tags$ul(class = "nav nav-pills navbar-nav", ...)
}

Besides, each navbar menu item could be either a simple button or contain multiple menu sub-items. For now, we only focus on simple items.

18.2.4.2 Fine tune tabs behavior

Quite good isn’t it? You notice however that even if the first tab is selected by default, its content is not shown. To fix this, we apply our jQuery skills. According to the Bootstrap documentation, we must trigger the show event on the active tab at start, as well as add the classes show and active to the associated tab panel in the dashboard body. We therefore target the nav item that has the active class and if no item is found, we select the first item by default and activate its body content.

$(function() {
  // this makes sure to trigger the show event on the active   tab at start
  let activeTab = $('#navbar-menu .nav-link.active');
  // if multiple items are found
  if (activeTab.length > 0) {
    let tabId = $(activeTab).attr('data-value');
    $(activeTab).tab('show');
    $(`#${tabId}`).addClass('show active');
  } else {
    $('#navbar-menu .nav-link')
      .first()
      .tab('show');
  }
});

This script is included in the the below app www folder. We see in Chapter 19 that custom input binding may perfectly handle this situation and are actually preferred.

thematic_shiny()
# example with custom JS code to activate tabs
shinyAppDir(system.file("tabler/tabler_tabs", package = "OSUICode"))

The result is shown on Figure 18.4. We’d also suggest to include at least one input/output per tab, to test whether everything works properly.

Tabler template with navbar

FIGURE 18.4: Tabler template with navbar

Looks like we are done for the main template elements. Actually, wouldn’t it be better to include, at least, card containers?

18.2.5 Card containers

Card are a central piece of template as they may contain visualizations, metrics and much more. Fortunately, Tabler has a large range of card containers.

18.2.5.1 Classic card

What we call a classic card is like the shinydashboard box() container. The card structure has key elements:

  • A width to control the space taken by the card in the Bootstrap grid.
  • A title, in general in the header (tabler does always not follow this rule and header is optional).
  • A body where is the main content.
  • Style elements like color statuses.
  • A footer (optional, tabler does not include this).

A comprehensive list of all tabler card features may be found here. To be faster, we copy the following HTML code in the html2R shiny app to convert it to Shiny tags:

<div class="col-md-6">
  <div class="card">
    <div class="card-status-top bg-danger"></div>
    <div class="card-body">
      <h3 class="card-title">Title</h3>
      <p>Some Text.</p>
    </div>
  </div>
</div>

Below is the result. The next step consists in replacing all content by parameters to the tabler_card() function, whenever necessary. For instance, the first <div> sets the card width. The Bootstrap grid ranges from 0 to 12, so why not creating a width parameter to control the card size. We proceed similarly for the title, status, body content. It seems reasonable to allow title to be NULL (if so, the title is not be shown), same thing for the status. Regarding the card default width, a value of six also makes sense, which would take half of the row:

tabler_card <- function(..., title = NULL, status = NULL, 
                        width = 6, padding = NULL) {
  
  card_cl <- paste0(
    "card", 
    if (!is.null(padding)) paste0(" card-", padding)
  )
  
  status_tag <- if (!is.null(status)) {
    div(class = paste0("card-status-top bg-", status))
  }
  
  body_tag <- div(
    class = "card-body",
    # we could have a smaller title like h4 or h5...
    if (!is.null(title)) {
      h3(class = "card-title", title)
    },
    ...
  )
  
  main_wrapper <- div(class = paste0("col-md-", width))
  card_wrapper <- div(class = card_cl)
  
  card_wrapper <- card_wrapper %>% tagAppendChildren(status_tag, body_tag)
  main_wrapper %>% tagAppendChild(card_wrapper)
}

In the meantime, it would be also convenient to be able to display cards in the same row. Let’s create the tabler_row():

tabler_row <- function(...) {
  div(class = "row row-deck", ...)
}

Below, we show an example of the tabler_card() function, in combination with the apexcharter package.

library(apexcharter)
library(dplyr)
library(ggplot2)
# test the card
data("economics_long")
economics_long <- economics_long %>%
  group_by(variable) %>%
  slice((n()-100):n())

spark_data <- data.frame(
  date = Sys.Date() + 1:20,
  var1 = round(rnorm(20, 50, 10)),
  var2 = round(rnorm(20, 50, 10)),
  var3 = round(rnorm(20, 50, 10))
)

my_card <- tabler_card(
  apexchartOutput("my_chart"), 
  title = "My card", 
  status = "danger"
)

thematic_shiny()

ui <- tabler_page(
  tabler_body(
    tabler_row(
      my_card,
      tabler_card(
        apexchartOutput("spark_box"), 
        title = "My card", 
        status = "success"
      ) 
    )
  )
)
server <- function(input, output) {
  output$my_chart <- renderApexchart({
    apex(
      data = economics_long, 
      type = "area", 
      mapping = aes(x = date, y = value01, fill = variable)
    ) %>%
      ax_yaxis(decimalsInFloat = 2) %>% # number of decimals to keep
      ax_chart(stacked = TRUE) %>%
      ax_yaxis(max = 4, tickAmount = 4)
  })
  
  output$spark_box <- renderApexchart({
    spark_box(
      data = spark_data[, c("date", "var3")],
      title = mean(spark_data$var3), 
      subtitle = "Variable 3",
      color = "#FFF", background = "#2E93fA",
      title_style = list(color = "#FFF"),
      subtitle_style = list(color = "#FFF")
    )
  })
}
shinyApp(ui, server)

The code output is shown on Figure 18.5.

Tabler card component

FIGURE 18.5: Tabler card component

18.2.6 Ribbons: card components

Let’s finish this part by including a card component, namely the ribbon.

tabler_ribbon <- function(..., position = NULL, color = NULL, bookmark = FALSE) {
  
  ribbon_cl <- paste0(
    "ribbon",
    if (!is.null(position)) sprintf(" bg-%s", position),
    if (!is.null(color)) sprintf(" bg-%s", color),
    if (bookmark) " ribbon-bookmark"
  )
  div(class = ribbon_cl, ...)
}

Integrating the freshly created ribbon component requires to modify the card structure since the ribbon is added after the body tag, and no parameter is associated with this slot. We could also modify the tabler_card() function but htmltools offers tools to help us. Since the ribbon should be put after the card body, we may think about the tagAppendChild() function, introduced in Chapter 2:

# add the ribbon to a card
my_card <- tabler_card(title = "Ribbon", status = "info")

str(my_card)
## List of 3
##  $ name    : chr "div"
##  $ attribs :List of 1
##   ..$ class: chr "col-md-6"
##  $ children:List of 1
##   ..$ :List of 3
##   .. ..$ name    : chr "div"
##   .. ..$ attribs :List of 1
##   .. .. ..$ class: chr "card"
##   .. ..$ children:List of 2
##   .. .. ..$ :List of 3
##   .. .. .. ..$ name    : chr "div"
##   .. .. .. ..$ attribs :List of 1
##   .. .. .. .. ..$ class: chr "card-status-top bg-info"
##   .. .. .. ..$ children: list()
##   .. .. .. ..- attr(*, "class")= chr "shiny.tag"
##   .. .. ..$ :List of 3
##   .. .. .. ..$ name    : chr "div"
##   .. .. .. ..$ attribs :List of 1
##   .. .. .. .. ..$ class: chr "card-body"
##   .. .. .. ..$ children:List of 1
##   .. .. .. .. ..$ :List of 3
##   .. .. .. .. .. ..$ name    : chr "h3"
##   .. .. .. .. .. ..$ attribs :List of 1
##   .. .. .. .. .. .. ..$ class: chr "card-title"
##   .. .. .. .. .. ..$ children:List of 1
##   .. .. .. .. .. .. ..$ : chr "Ribbon"
##   .. .. .. .. .. ..- attr(*, "class")= chr "shiny.tag"
##   .. .. .. ..- attr(*, "class")= chr "shiny.tag"
##   .. ..- attr(*, "class")= chr "shiny.tag"
##  - attr(*, "class")= chr "shiny.tag"
my_card$children[[1]] <- my_card$children[[1]] %>% 
  tagAppendChild(
    tabler_ribbon(
      icon("info-circle", class = "fa-lg"), 
      bookmark = TRUE,
      color = "red"
    )
  )

As shown above, the ribbon has been successfuly included in the card tag. Now, we check how it looks in a shiny app.

thematic_shiny()
ui <- tabler_page(
  tabler_body(
    my_card
  )
)
server <- function(input, output) {}
shinyApp(ui, server)
Tabler ribbon component

FIGURE 18.6: Tabler ribbon component

18.2.7 Icons

Not mentioned before but we may include fontawesome icons provided with Shiny, as well as other libraries. Moreover, Tabler has a internal svg library located here.

18.3 Exercises

  1. Consider the tab card at the very bottom of the tabler documentation. Propose an implementation of that feature.
  2. Have a look at this page. Select two elements and create the corresponding R functions.