Introduction to Quarto Dashboards 📊📈🎛️📶

Jeremy Selva
@JauntyJJS
https://jeremy-selva.netlify.app
For R User Group Singapore (RUGS) Meetup

29th November 2024

whoami

Research Officer from National Heart Centre Singapore who collects, cleans and harmonises clinical data.

Picture by Allison Horst about a data analyst facing a dataset in the form of a monster.

Taming the Data Beast from “Cleaning Medical Data with R” workshop by Shannon Pileggi, Crystal Lewis and Petter Higgins presented at R/Medicine 2023. Illustrated by Allison Horst.

https://jauntyjjs.github.io/rugs_20241129

Quarto

Quarto is an open-source software that weaves narrative and programming code together to produce elegantly formatted output as documents (in HTML, Word, PDF), presentations, books, web pages, and more.

Picture by Allison Horst about Quarto turning programming code to documents. Artwork from “Hello, Quarto” keynote by Julia Lowndes and Mine Çetinkaya-Rundel, presented at RStudio Conference 2022. Illustrated by Allison Horst.

https://jauntyjjs.github.io/rugs_20241129

Quarto

https://quarto.org/

https://jauntyjjs.github.io/rugs_20241129

Quarto Dashboards (Released in Quarto 1.4)

A simple way to quickly creating dashboards from Quarto scripts using R, Python, Julia, and Observable

Publish groups of visualizations, tables, text together. See examples in https://quarto.org/docs/gallery/index.html#dashboards

A list of Quarto dashboard example.

https://jauntyjjs.github.io/rugs_20241129

Dashboard Basics

Dashboards are composed of cards of text, plot and tables in pages

Cards (unaranged).

https://jauntyjjs.github.io/rugs_20241129

Dashboard Basics

Dashboards are composed of cards of text, plot and tables in pages that need to be arranged neatly into rows and columns.

Cards arranged to tell what the project is about.

Cards arranged to show the results.

https://jauntyjjs.github.io/rugs_20241129

Motivation

CNA reported that Singapore’s total fertility rate was below 1 for the first time.

Channel News Asia news headline: Singapore's total fertility rate falls to historic low of 0.97

https://jauntyjjs.github.io/rugs_20241129

Motivation

Data is downloaded from Department Of Statistics Singapore

Births and Fertility data from the Department Of Statistics Singapore website

https://jauntyjjs.github.io/rugs_20241129

Motivation

Alternatively, it can be downloaded from https://data.gov.sg/

https://jauntyjjs.github.io/rugs_20241129

Motivation

A preview of the dataset.

birth_data <- readxl::read_excel(
  path = here::here(
    "data", 
    "Live-Births By Sex And Ethnic Group, Monthly.xlsx"
  )
)
fertility_rate_data <- readxl::read_excel(
  path = here::here(
    "data", 
    "Fertility Rate By Ethnic Group, Yearly.xlsx"
  )
)

https://jauntyjjs.github.io/rugs_20241129

Motivation

Can Quarto Dashboard create something similar to the Fertility Dashboard from Department of Statistics Singapore ?

Fertility Dashboard from Department of Statistics Singapore.

https://jauntyjjs.github.io/rugs_20241129

Open A Quarto Document

Create a Quarto document

Steps to create a Quarto document

https://jauntyjjs.github.io/rugs_20241129

Open A Quarto Document

Clear everything in file and type the following yaml header (surrounded by ---) and click “Render”

index.qmd
---
title: "SG Fertility Dashboard"
format: 
  dashboard:
    nav-buttons: [github]
    github: https://github.com/JauntyJJS/fertility_dashboard
---

Steps to render a Quarto document to an empty dashboard

Output from the above command

https://jauntyjjs.github.io/rugs_20241129

Code Chunks

R codes are to be placed in between the ```{r} and ``` code chunks.

library(here) # A Simpler Way to Find Your Files Posit RPSM v1.0.1
library(readxl) # Read Excel Files Posit RPSM v1.4.3
library(tibble) # Simple Data Frames Posit RPSM v3.2.1
library(fs) # Cross-Platform File System Operations Based on 'libuv' Posit RPSM v1.6.5
library(rmarkdown)  # Dynamic Documents for R Posit RPSM v2.28
library(yaml) # Methods to Convert R Data to YAML and Back Posit RPSM v2.3.10
library(quarto) # R Interface to 'Quarto' Markdown Publishing System Posit RPSM v1.4.4
library(sessioninfo) # R Session Information Posit RPSM v1.2.2
library(dplyr) # A Grammar of Data Manipulation Posit RPSM v1.1.4
library(tidyr) # Tidy Messy Data Posit RPSM v1.3.1
library(forcats) # Tools for Working with Categorical Variables (Factors) Posit RPSM v1.0.0
library(glue) # Interpreted String Literals Posit RPSM v1.8.0
library(plotly) # Create Interactive Web Graphics via 'plotly.js' Posit RPSM v4.10.4
library(htmltools) # Tools for HTML Posit RPSM v0.5.8.1
library(reactable) # Interactive Data Tables for R Posit RPSM v0.4.4
library(crosstalk) # Inter-Widget Interactivity for HTML Widgets Posit RPSM v1.2.1
library(fontawesome) # Easily Work with 'Font Awesome' Icons Posit RPSM v0.5.2

How to load all libraries in a Quarto Code Chunk

https://jauntyjjs.github.io/rugs_20241129

Pages

The text of the level 1 headings #{Page Title} helps to create pages in the navigation bar.

index.qmd
---
title: "SG Fertility Dashboard"
format: 
  dashboard:
    nav-buttons: [github]
    github: https://github.com/JauntyJJS/fertility_dashboard
---

# Fertility Rate {orientation="rows" scrolling="true"}

# Live Birth {orientation="rows" scrolling="true"}

# About {orientation="columns" scrolling="true"}
dashboard with pages but no content

https://jauntyjjs.github.io/rugs_20241129

Layout for About

The orientation="columns" settings ensures cards are first laid out by columns and then by rows. Column space can be allocated using level 2 headings ## Column

index.qmd
# About {orientation="columns" scrolling="true"}

## Column {width="60%"}

## Column {width="40%"}
column orientation layout

https://jauntyjjs.github.io/rugs_20241129

Cards for About

To create cards that has text or markdown, it is better to use the ::: {.card title="Your title"} block.

index.qmd
# About {orientation="columns" scrolling="true"}

## Column - About the Dashboard {width="60%"}

::: {.card title="📊 About The Dashboard"}

Your markdown text here

:::

## Column - R Session and Packages Used {width="40%"}

About page with a card titled: About The Dashboard with text example

https://jauntyjjs.github.io/rugs_20241129

Cards for About

To create cards that uses R codes, use ```{r} code chunks.

index.qmd
# About {orientation="columns" scrolling="true"}

## Column - About the Dashboard {width="60%"}

::: {.card title="📊 About The Dashboard"}

Your markdown text here

:::

## Column - R Session and Packages Used {width="40%"}

```{r}
#| label: R Package Used
#| title: "R Packages Used"

head(sessioninfo::package_info())

```

```{r}
#| label: R Session Info
#| title: "R Session Info"

head(sessioninfo::platform_info())

```

About page with a card titled:

https://jauntyjjs.github.io/rugs_20241129

Cards for About

Here are the contents to create the About the dashboard chunks.

index.qmd
# About {orientation="columns" scrolling="true"}

## Column - About the Dashboard {width="60%"}

::: {.card title="📊 About The Dashboard"}

This dashboard is built with [Quarto Dashboards](https://quarto.org/docs/dashboards/){target="_blank"}. It is based on the [Fertility Dashboard](https://www.singstat.gov.sg/find-data/search-by-theme/population/births-and-fertility/visualising-data/fertility-dashboard){target="_blank"} from [Department of Statistics Singapore](https://www.singstat.gov.sg/){target="_blank"}.

If you want to conduct your own analysis, see the following resources:

+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Resource                            | Link                                                                                                                                                                                              |
+=====================================+===================================================================================================================================================================================================+
| Births and Fertility Data           | [<i class='bi bi-globe' style='color:#000000;'></i> Website](https://www.singstat.gov.sg/find-data/search-by-theme/population/births-and-fertility/latest-data){target="_blank"}                  |
| Department of Statistics Singapore  |                                                                                                                                                                                                   |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Fertility Rate By Ethnic Group,     | [<i class='bi bi-globe' style='color:#000000;'></i> Website](https://data.gov.sg/datasets/d_e39eeaeadb571c0d0725ef1eec48d166/view){target="_blank"}                                               |
| Yearly from                         |                                                                                                                                                                                                   |
| [data.gov.sg](https://data.gov.sg/) |                                                                                                                                                                                                   |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Live-Births By Sex And Ethnic       | [<i class='bi bi-globe' style='color:#000000;'></i> Website](https://data.gov.sg/datasets/d_d05c760928eb5eaa58006d83462b834e/view){target="_blank"}                                               |
| Group, Monthly from                 |                                                                                                                                                                                                   |
| [data.gov.sg](https://data.gov.sg/) |                                                                                                                                                                                                   |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Fertility Rate By Ethnic Group,     | [<i class='bi bi-file-earmark-excel-fill' style='color:#108445'></i> Fertility Rate By Ethnic Group, Yearly.xlsx](data/Fertility Rate By Ethnic Group, Yearly.xlsx){target="_blank"}              |
| Yearly till 2023 in Excel           |                                                                                                                                                                                                   |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Live-Births By Sex And Ethnic       | [<i class='bi bi-file-earmark-excel-fill' style='color:#108445'></i> Live-Births By Sex And Ethnic Group, Monthly.xlsx](data/Live-Births By Sex And Ethnic Group, Monthly.xlsx){target="_blank"}  |
| Group, Monthly till Dec 2023        |                                                                                                                                                                                                   |
| in Excel                            |                                                                                                                                                                                                   |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Quarto script to create Dashboard   | [<i class='bi bi-file-code-fill' style='color:#77acdf;'></i> Quarto Script](index.qmd){target="_blank"}                                                                                           |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Github repository                   | [<i class='bi bi-github' style='color:#000000;'></i> Source code](https://github.com/JauntyJJS/fertility_dashboard){target="_blank"}                                                              |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Quarto Resources from               | [<i class='bi bi-github' style='color:#000000;'></i> Resources](https://github.com/ivelasq/2024-07-18_quarto-dashboards){target="_blank"}                                                         |
| Isabella Velásquez                  |                                                                                                                                                                                                   |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Quarto Tutorials from               | [<i class='bi bi-youtube' style='color:#ff0034;'></i> 1: Hello, Dashboards!](https://www.youtube.com/watch?v=HW7QbqI4fH0){target="_blank"}<br>                                                    |
| Mine Çetinkaya-Rundel               | [<i class='bi bi-youtube' style='color:#ff0034;'></i> 2: Components](https://www.youtube.com/watch?v=KdsQgwaY950){target="_blank"}<br>                                                            |
|                                     | [<i class='bi bi-youtube' style='color:#ff0034;'></i> 3: Theming and Styling](https://www.youtube.com/watch?v=NigWSB-jG4Y){target="_blank"}                                                       |
+-------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+

Births And Fertility Rates, Annual and Live-Births By Sex And Ethnic Group data were accessed on 25 November 2024 from <https://data.gov.sg/>. Data is made available under the terms of [Singapore Open Data Licence version 1.0](https://data.gov.sg/open-data-licence)

Made by Jeremy Selva [`<svg aria-hidden="true" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#0077ac;overflow:visible;position:relative;"><path d="M416 32H31.9C14.3 32 0 46.5 0 64.3v383.4C0 465.5 14.3 480 31.9 480H416c17.6 0 32-14.5 32-32.3V64.3c0-17.8-14.4-32.3-32-32.3zM135.4 416H69V202.2h66.5V416zm-33.2-243c-21.3 0-38.5-17.3-38.5-38.5S80.9 96 102.2 96c21.2 0 38.5 17.3 38.5 38.5 0 21.3-17.2 38.5-38.5 38.5zm282.1 243h-66.4V312c0-24.8-.5-56.7-34.5-56.7-34.6 0-39.9 27-39.9 54.9V416h-66.4V202.2h63.7v29.2h.9c8.9-16.8 30.6-34.5 62.9-34.5 67.2 0 79.7 44.3 79.7 101.9V416z"/></svg>`{=html}](https://www.linkedin.com/in/jeremy-selva-085b9112a/){target="_blank"} <br> @JauntyJJS [`<svg aria-hidden="true" role="img" viewBox="0 0 496 512" style="height:1em;width:0.97em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#000000;overflow:visible;position:relative;"><path d="M165.9 397.4c0 2-2.3 3.6-5.2 3.6-3.3.3-5.6-1.3-5.6-3.6 0-2 2.3-3.6 5.2-3.6 3-.3 5.6 1.3 5.6 3.6zm-31.1-4.5c-.7 2 1.3 4.3 4.3 4.9 2.6 1 5.6 0 6.2-2s-1.3-4.3-4.3-5.2c-2.6-.7-5.5.3-6.2 2.3zm44.2-1.7c-2.9.7-4.9 2.6-4.6 4.9.3 2 2.9 3.3 5.9 2.6 2.9-.7 4.9-2.6 4.6-4.6-.3-1.9-3-3.2-5.9-2.9zM244.8 8C106.1 8 0 113.3 0 252c0 110.9 69.8 205.8 169.5 239.2 12.8 2.3 17.3-5.6 17.3-12.1 0-6.2-.3-40.4-.3-61.4 0 0-70 15-84.7-29.8 0 0-11.4-29.1-27.8-36.6 0 0-22.9-15.7 1.6-15.4 0 0 24.9 2 38.6 25.8 21.9 38.6 58.6 27.5 72.9 20.9 2.3-16 8.8-27.1 16-33.7-55.9-6.2-112.3-14.3-112.3-110.5 0-27.5 7.6-41.3 23.6-58.9-2.6-6.5-11.1-33.3 2.6-67.9 20.9-6.5 69 27 69 27 20-5.6 41.5-8.5 62.8-8.5s42.8 2.9 62.8 8.5c0 0 48.1-33.6 69-27 13.7 34.7 5.2 61.4 2.6 67.9 16 17.7 25.8 31.5 25.8 58.9 0 96.5-58.9 104.2-114.8 110.5 9.2 7.9 17 22.9 17 46.4 0 33.7-.3 75.4-.3 83.6 0 6.5 4.6 14.4 17.3 12.1C428.2 457.8 496 362.9 496 252 496 113.3 383.5 8 244.8 8zM97.2 352.9c-1.3 1-1 3.3.7 5.2 1.6 1.6 3.9 2.3 5.2 1 1.3-1 1-3.3-.7-5.2-1.6-1.6-3.9-2.3-5.2-1zm-10.8-8.1c-.7 1.3.3 2.9 2.3 3.9 1.6 1 3.6.7 4.3-.7.7-1.3-.3-2.9-2.3-3.9-2-.6-3.6-.3-4.3.7zm32.4 35.6c-1.6 1.3-1 4.3 1.3 6.2 2.3 2.3 5.2 2.6 6.5 1 1.3-1.3.7-4.3-1.3-6.2-2.2-2.3-5.2-2.6-6.5-1zm-11.4-14.7c-1.6 1-1.6 3.6 0 5.9 1.6 2.3 4.3 3.3 5.6 2.3 1.6-1.3 1.6-3.9 0-6.2-1.4-2.3-4-3.3-5.6-2z"/></svg>`{=html}](https://github.com/JauntyJJS){target="_blank"} [`<svg aria-hidden="true" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#000000;overflow:visible;position:relative;"><path d="M64 32C28.7 32 0 60.7 0 96V416c0 35.3 28.7 64 64 64H384c35.3 0 64-28.7 64-64V96c0-35.3-28.7-64-64-64H64zm297.1 84L257.3 234.6 379.4 396H283.8L209 298.1 123.3 396H75.8l111-126.9L69.7 116h98l67.7 89.5L313.6 116h47.5zM323.3 367.6L153.4 142.9H125.1L296.9 367.6h26.3z"/></svg>`{=html}](https://twitter.com/JauntyJJS){target="_blank"} [`<svg aria-hidden="true" role="img" viewBox="0 0 576 512" style="height:1em;width:1.12em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#1084ff;overflow:visible;position:relative;"><path d="M407.8 294.7c-3.3-.4-6.7-.8-10-1.3c3.4 .4 6.7 .9 10 1.3zM288 227.1C261.9 176.4 190.9 81.9 124.9 35.3C61.6-9.4 37.5-1.7 21.6 5.5C3.3 13.8 0 41.9 0 58.4S9.1 194 15 213.9c19.5 65.7 89.1 87.9 153.2 80.7c3.3-.5 6.6-.9 10-1.4c-3.3 .5-6.6 1-10 1.4C74.3 308.6-9.1 342.8 100.3 464.5C220.6 589.1 265.1 437.8 288 361.1c22.9 76.7 49.2 222.5 185.6 103.4c102.4-103.4 28.1-156-65.8-169.9c-3.3-.4-6.7-.8-10-1.3c3.4 .4 6.7 .9 10 1.3c64.1 7.1 133.6-15.1 153.2-80.7C566.9 194 576 75 576 58.4s-3.3-44.7-21.6-52.9c-15.8-7.1-40-14.9-103.2 29.8C385.1 81.9 314.1 176.4 288 227.1z"/></svg>`{=html}](https://bsky.app/profile/jauntyjjs.bsky.social){target="_blank"} [<svg aria-hidden="true" role="img" viewBox="0 0 512 512" style="height:1em;width:1em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#5f53e7;overflow:visible;position:relative;"><path d="M433 179.1c0-97.2-63.7-125.7-63.7-125.7-62.5-28.7-228.6-28.4-290.5 0 0 0-63.7 28.5-63.7 125.7 0 115.7-6.6 259.4 105.6 289.1 40.5 10.7 75.3 13 103.3 11.4 50.8-2.8 79.3-18.1 79.3-18.1l-1.7-36.9s-36.3 11.4-77.1 10.1c-40.4-1.4-83-4.4-89.6-54a102.5 102.5 0 0 1 -.9-13.9c85.6 20.9 158.7 9.1 178.8 6.7 56.1-6.7 105-41.3 111.2-72.9 9.8-49.8 9-121.5 9-121.5zm-75.1 125.2h-46.6v-114.2c0-49.7-64-51.6-64 6.9v62.5h-46.3V197c0-58.5-64-56.6-64-6.9v114.2H90.2c0-122.1-5.2-147.9 18.4-175 25.9-28.9 79.8-30.8 103.8 6.1l11.6 19.5 11.6-19.5c24.1-37.1 78.1-34.8 103.8-6.1 23.7 27.3 18.4 53 18.4 175z"/></svg>](https://fosstodon.org/@JauntyJJS){target="_blank"}

:::

## Column - R Session and Packages Used {width="40%"}

```{r}
#| label: R Package Used
#| title: "📦 R Packages Used"

get_r_package_info <- function() {

  r_package_table <- sessioninfo::package_info()
  rownames(r_package_table) <- NULL

  r_package_table <- r_package_table |>
    tibble::as_tibble() |>
    dplyr::mutate(
      version = ifelse(is.na(r_package_table$loadedversion),
                       r_package_table$ondiskversion,
                       r_package_table$loadedversion)) |>
    dplyr::filter(.data[["attached"]] == TRUE) |>
    dplyr::select(
      dplyr::any_of(c("package", "version",
                      "date", "source"))
    )

  return(r_package_table)

}

get_r_package_info() |>
  reactable::reactable(
    defaultPageSize = 5,
    paginationType = "jump",
  )

```

```{r}
#| label: R Session Info
#| title: "💻 R Session Info"

get_quarto_version <- function(
    test_sys_path = FALSE,
    test_no_path = FALSE
) {

  # Taken from https://github.com/r-lib/sessioninfo/issues/75
  if (isNamespaceLoaded("quarto") && isFALSE(test_sys_path)) {
    path <- quarto::quarto_path() |>
      fs::path_real()
    ver <- system("quarto -V", intern = TRUE)
    if (is.null(path) || isTRUE(test_no_path)) {
      "NA (via quarto)"
    } else {
      paste0(ver, " @ ", path, "/ (via quarto)")
    }
  } else {
    path <- Sys.which("quarto") |>
      fs::path_real()
    if (path == "" || isTRUE(test_no_path)) {
      "NA"
    } else {
      ver <- system("quarto -V", intern = TRUE)
      paste0(ver, " @ ", path)
    }
  }
}


get_knitr_version <- function() {

  knitr_info <- "NA"

  r_package_table <- sessioninfo::package_info(
    pkgs = c("installed")
  ) |>
    dplyr::filter(.data[["package"]] == "knitr")

  if (nrow(r_package_table) == 1) {

    knitr_version <- r_package_table$loadedversion[1]
    knitr_source <- r_package_table$source[1]

    knitr_info <- paste0(
      knitr_version, " from ",
      knitr_source)
  }

  return(knitr_info)

}

get_r_platform_info <- function() {

  r_platform_table <- sessioninfo::platform_info()
  r_platform_table[["quarto"]] <- get_quarto_version()[1]
  r_platform_table[["knitr"]] <- get_knitr_version()[1]

  r_platform_table <- data.frame(
    setting = names(r_platform_table),
    value = unlist(r_platform_table,
                   use.names = FALSE),
    stringsAsFactors = FALSE
  )

  return(r_platform_table)
}

r_platform_table <- get_r_platform_info()

r_platform_table |>
  reactable::reactable(
    defaultPageSize = 5,
    paginationType = "jump",
  )


```

About page with a card titled: About The Dashboard with text completed

https://jauntyjjs.github.io/rugs_20241129

Layout and Cards for Fertility Rate

The orientation="rows" settings ensures cards are first laid out by rows and then by columns.

Indicating #| content: valuebox in the R code chunk will give out a value box.

index.qmd
# Fertility Rate {orientation="rows" scrolling="true"}

## Row - 2023 Fertility Value Boxes

```{r}
#| label: Value Box 1
#| content: valuebox
#| title: "2023 Fertility Rate (Total*)"

list(
  icon = "person-standing-dress",
  color = "#b67e54",
  value = "A Value"
)

```

```{r}
#| label: Value Box 2
#| content: valuebox
#| title: "2023 Fertility Rate (Chinese)"

list(
  icon = "person-standing-dress",
  color = "#efb9e7",
  value = "A Value"
)

```

```{r}
#| label: Value Box 3
#| content: valuebox
#| title: "2023 Fertility Rate (Malays)"

list(
  icon = "person-standing-dress",
  color = "#90ee90",
  value = "A Value"
)

```

```{r}
#| label: Value Box 4
#| content: valuebox
#| title: "2023 Fertility Rate (Indians)"

list(
  icon = "person-standing-dress",
  color = "#c5bce0",
  value = "A Value"
)

```

## Row - Fertility Rate Plot and Table

### Column - Fertility Rate Plot

```{r}
#| label: Total Fertility Rate by Ethnicity Plot
#| title: ""

print("a plot")

```

### Column - Fertility Rate Table

```{r}
#| label: Total Fertility Rate by Ethnicity Table
#| title: "𝄜 Total Fertility Rate Data"

print("a table")

```
A dashboard with four value boxes in the first row and in the second row, one column reserved for the graph and the other column reserved for the table

https://jauntyjjs.github.io/rugs_20241129

Tables and Plots for Fertility Rate Page

fertility_rate_data_year_for_table <- fertility_rate_data |>
  tidyr::pivot_longer(
    cols = -c("Ethnicity"),
    names_to = c("Year"),
    values_to = "Total_Fertility_Rate_Per_Female"
  ) |>
  dplyr::mutate(
    Ethnicity = dplyr::case_when(
      .data[["Ethnicity"]] == "Chinese (Per Female)" ~ "Chinese",
      .data[["Ethnicity"]] == "Malays (Per Female)" ~ "Malays",
      .data[["Ethnicity"]] == "Indians (Per Female)" ~ "Indians",
      .data[["Ethnicity"]] == "All (Per Female)" ~ "Total*",
    ),
    Ethnicity = forcats::fct_relevel(
      .data[["Ethnicity"]],
      c("Chinese", "Malays", "Indians", "Total*")
    )
  ) |>
  dplyr::filter(
    .data[["Year"]] >= 1980
  ) |>
  dplyr::mutate(
    Year = as.numeric(.data[["Year"]])
  ) |>
  dplyr::rename(
    `Fertility Rate Per Female` = "Total_Fertility_Rate_Per_Female"
  )

data <- crosstalk::SharedData$new(fertility_rate_data_year_for_table)

htmltools::div(
  style = "display: grid; grid-template-columns: repeat(auto-fit, minmax(200px, 1fr)); gap: 0.75rem;",
  htmltools::div(
    crosstalk::filter_select(
      id = "Ethnicity",
      label = "Ethnicity",
      sharedData = data,
      group = ~Ethnicity,
      allLevels = TRUE),
    crosstalk::filter_slider(
      id = "Year",
      label = "Year",
      sharedData = data,
      column = "Year"),
    crosstalk::filter_slider(
      id = "Fertility Rate Per Female",
      label = "Fertility Rate Per Female",
      sharedData = data,
      column = "Fertility Rate Per Female",
      width = "100%")
  ),
  htmltools::div(
    style = "grid-column: span 3;",
    htmltools::browsable(
      htmltools::tagList(
        reactable::reactable(data, minRows = 10, elementId = "tfr-table", paginationType = "jump"),
        htmltools::tags$button("Download as CSV", onclick = "Reactable.downloadDataCSV('tfr-table')")
      )
    )
  )
)

https://jauntyjjs.github.io/rugs_20241129

Tables and Plots for Fertility Rate Page

fertility_rate_data_year_for_plot <- fertility_rate_data |>
  tidyr::pivot_longer(
    cols = -c("Ethnicity"),
    names_to = c("Year"),
    values_to = "Total_Fertility_Rate_Per_Female"
  ) |>
  dplyr::mutate(
    Ethnicity = dplyr::case_when(
      .data[["Ethnicity"]] == "Chinese (Per Female)" ~ "Chinese",
      .data[["Ethnicity"]] == "Malays (Per Female)" ~ "Malays",
      .data[["Ethnicity"]] == "Indians (Per Female)" ~ "Indians",
      .data[["Ethnicity"]] == "All (Per Female)" ~ "Total*",
    ),
    Ethnicity = forcats::fct_relevel(
      .data[["Ethnicity"]],
      c("Chinese", "Malays", "Indians", "Total*")
    )
  ) |>
  dplyr::filter(
    .data[["Year"]] >= 1980
  )

# For the hover text
text_input <- glue::glue(
   "{fertility_rate_data_year_for_plot[['Ethnicity']]}: {format(fertility_rate_data_year_for_plot[['Total_Fertility_Rate_Per_Female']], big.mark = ",", digits = 2)}"
)

plot <- plotly::plot_ly() |>
  plotly::add_trace(
    data = fertility_rate_data_year_for_plot,
    x = fertility_rate_data_year_for_plot[["Year"]],
    y = fertility_rate_data_year_for_plot[["Total_Fertility_Rate_Per_Female"]],
    color = fertility_rate_data_year_for_plot[["Ethnicity"]],
    colors = c(Chinese = "#efb9e7",
               Malays = "#90ee90",
               Indians = "#c5bce0",
               `Total*` = "#b67e54"),
    type = "scatter",
    mode = "lines+markers",
    marker = list(
      size = 10,
      line = list(color = "black", width = 1.5)
    ),
    linetype = fertility_rate_data_year_for_plot[["Ethnicity"]],
    linetypes = c(Chinese = "solid",
                  Malays = "solid",
                  Indians = "solid",
                  `Total*` = "solid"),
    line = list(
      width = 5
    ),
    name = fertility_rate_data_year_for_plot[["Ethnicity"]],
    text = text_input,
    hovertemplate = '%{text}<extra></extra>'
  ) |>
  plotly::layout(
    title = list(text = "<b>Resident Total Fertility Rate by Ethnicity<b>" ,
                 x = 0.5,
                 y = 1,
                 pad = list(l = 5, r = 5, b = 5, t = 20),
                 xanchor = 'center',
                 font = list(size = 20)),
    xaxis = list(title = "",
                 titlefont = list(size = 10),
                 tickfont = list(size = 12),
                 tickangle = -30,
                 gridcolor = "#eff5ee",
                 showgrid = TRUE,
                 showticklabels = TRUE,
                 tickcolor = "",
                 ticks = "",
                 zeroline = FALSE,
                 rangeslider = list(thickness = 0.05),
                 autorange = TRUE,
                 automargin = TRUE,
                 fixedrange = FALSE),
    yaxis = list(title = "",
                 titlefont = list(size = 10),
                 tickfont = list(size = 12),
                 gridcolor = "#c8cdc6",
                 showgrid = TRUE,
                 showline = FALSE,
                 showticklabels = TRUE,
                 tickcolor = "",
                 ticks = "",
                 zeroline = TRUE,
                 range = list(0, 3),
                 rangemode = "tozero",
                 autorange = FALSE,
                 automargin = TRUE,
                 fixedrange = TRUE),
    hovermode = "x unified",
    legend = list(
      title = list(text = "Ethnicity"),
      orientation = 'h',
      # Centered at x axis
      xanchor = "center",
      x = 0.5,
      # Place on the top
      y = 1,
      font = list(size = 14)
    ),
    autosize = TRUE,
    plot_bgcolor = "#eff5ee",
    paper_bgcolor = "#eff5ee",
    margin = list(l = 10, r = 10, b = 10, t = 50, pad = 10)
  ) |>
  plotly::add_annotations(
    x = 0,
    y = 1,
    xref = "paper",
    yref = "paper",
    yanchor = "bottom",
    text = "Total Fertility Rate\nPer Female",
    showarrow = FALSE,
    font = list(size = 15)
  ) |>
  plotly::add_annotations(
    x = 0,
    y = 0,
    xref = "paper",
    yref = "paper",
    text = "*\tIncludes the ethnic group 'Others'",
    showarrow = FALSE,
    font = list(size = 10)
  )

plot

https://jauntyjjs.github.io/rugs_20241129

Layout and Cards for Live Birth

The {.tabset} settings allow cards to have tabs to provide multiple views of data.

index.qmd
# Live Birth {orientation="rows" scrolling="true"}

## Row - Live Birth Plot and Table

### Column - Live Birth Plot {.tabset}

```{r}
#| label: Total Live Birth by Ethnicity Plot
#| title: "🙋🏻‍♀ 🙋🏻‍♂ All"

print("a plot for all gender")

```

```{r}
#| label: Total Male Live Birth by Ethnicity Plot
#| title: "🙋🏻‍♂️ Male"

print("a plot for male")

```

```{r}
#| label: Total female Live Birth by Ethnicity Plot
#| title: "🙋🏻‍♀️ Female"

print("a plot for Female")

```

### Column - Live Birth Table

```{r}
#| label: Total Birth Data by Ethnicity Table
#| title: "𝄜 Total Birth Data"

print("a table")

```
A dashboard with one column reserved for the graph in a tabset and the other column reserved for the table

https://jauntyjjs.github.io/rugs_20241129

Tables and Plots for Live Birth

birth_data_long <- birth_data |>
  tidyr::pivot_longer(
    cols = -c("Ethnicity", "Gender"),
    names_to = c("Year", "Month"),
    names_pattern = "(\\d{4})(\\w{3})",
    values_to = "count"
  ) |>
  dplyr::mutate(
    Ethnicity = forcats::fct_relevel(
      .data[["Ethnicity"]],
      c("Chinese", "Malays", "Indians", "Others")
    )
  )

birth_data_both_gender <- birth_data_long |>
  dplyr::summarise(
    total_live_birth = sum(.data[["count"]], na.rm = TRUE),
    .by = c("Ethnicity", "Year", "Gender")
  ) |>
  dplyr::filter(
    .data[["Year"]] >= 1980 & .data[["Gender"]] == "All"
  )

birth_data_male <- birth_data_long |>
  dplyr::summarise(
    total_live_birth = sum(.data[["count"]], na.rm = TRUE),
    .by = c("Ethnicity", "Year", "Gender")
  ) |>
  dplyr::filter(
    .data[["Year"]] >= 1980 & .data[["Gender"]] == "Male"
  )

birth_data_female <- birth_data_long |>
  dplyr::summarise(
    total_live_birth = sum(.data[["count"]], na.rm = TRUE),
    .by = c("Ethnicity", "Year", "Gender")
  ) |>
  dplyr::filter(
    .data[["Year"]] >= 1980 & .data[["Gender"]] == "Female"
  )

birth_data_for_display <- dplyr::bind_rows(
  birth_data_both_gender,
  birth_data_male,
  birth_data_female
) |>
  dplyr::mutate(
    Year = as.numeric(.data[["Year"]])
  ) |>
  dplyr::rename(
    `Total Live Birth` = "total_live_birth"
  ) |>
  dplyr::relocate(
    "Gender",
    .after = "Ethnicity"
  )

data <- crosstalk::SharedData$new(birth_data_for_display)

htmltools::div(
  style = "display: grid; grid-template-columns: repeat(auto-fit, minmax(200px, 1fr)); gap: 0.75rem;",
  htmltools::div(
    crosstalk::filter_select(
      id = "Ethnicity",
      label = "Ethnicity",
      sharedData = data,
      group = ~Ethnicity,
      allLevels = TRUE),
    crosstalk::filter_checkbox(
      id = "Gender",
      label = "Gender",
      sharedData = data,
      group = ~Gender,
      allLevels = TRUE),
    crosstalk::filter_slider(
      id = "Year",
      label = "Year",
      sharedData = data,
      column = "Year"),
    crosstalk::filter_slider(
      id = "Total Live Birth",
      label = "Total Live Birth",
      sharedData = data,
      column = "Total Live Birth",
      width = "100%")
  ),
  htmltools::div(
    style = "grid-column: span 3;",
    htmltools::browsable(
      htmltools::tagList(
        reactable::reactable(data, minRows = 10, elementId = "birth-table", paginationType = "jump"),
        htmltools::tags$button("Download as CSV", onclick = "Reactable.downloadDataCSV('birth-table')")
      )
    )
  )
)

https://jauntyjjs.github.io/rugs_20241129

Tables and Plots for Live Birth

birth_data_long <- birth_data |>
  tidyr::pivot_longer(
    cols = -c("Ethnicity", "Gender"),
    names_to = c("Year", "Month"),
    names_pattern = "(\\d{4})(\\w{3})",
    values_to = "count"
  ) |>
  dplyr::mutate(
    Ethnicity = forcats::fct_relevel(
      .data[["Ethnicity"]],
      c("Chinese", "Malays", "Indians", "Others")
    )
  )

birth_data_both_gender <- birth_data_long |>
  dplyr::summarise(
    total_live_birth = sum(.data[["count"]], na.rm = TRUE),
    .by = c("Ethnicity", "Year", "Gender")
  ) |>
  dplyr::filter(
    .data[["Year"]] >= 1980 & .data[["Gender"]] == "All"
  )

# For the hover text
text_input <- glue::glue(
   "{birth_data_both_gender[['Ethnicity']]}: {birth_data_both_gender[['total_live_birth']]}"
)

plot <- plotly::plot_ly() |>
  plotly::add_trace(
    data = birth_data_both_gender,
    x = birth_data_both_gender[["Year"]],
    y = birth_data_both_gender[["total_live_birth"]],
    color = birth_data_both_gender[["Ethnicity"]],
    colors = c(Chinese = "#efb9e7",
               Malays = "#90ee90",
               Indians = "#c5bce0",
               Others = "#b67e54"),
    type = "scatter",
    mode = "lines+markers",
    marker = list(
      size = 10,
      line = list(color = "black", width = 1.5)
    ),
    line = list(
      width = 5
    ),
    linetype = birth_data_both_gender[["Ethnicity"]],
    linetypes = c(Chinese = "solid",
                  Malays = "solid",
                  Indians = "solid",
                  Others = "solid"),
    name = birth_data_both_gender[["Ethnicity"]],
    text = text_input,
    hovertemplate = '%{text}<extra></extra>'
  ) |>
  plotly::layout(
    title = list(text = "<b>Resident Total Live Birth by Ethnicity<b>" ,
                 x = 0.5,
                 y = 1,
                 pad = list(l = 5, r = 5, b = 5, t = 20),
                 xanchor = 'center',
                 font = list(size = 20)),
    xaxis = list(title = "",
                 titlefont = list(size = 10),
                 tickfont = list(size = 12),
                 tickangle = -30,
                 gridcolor = "#eff5ee",
                 showgrid = TRUE,
                 showticklabels = TRUE,
                 tickcolor = "",
                 ticks = "",
                 zeroline = FALSE,
                 rangeslider = list(thickness = 0.05),
                 automargin = TRUE,
                 autorange = TRUE,
                 fixedrange = FALSE),
    yaxis = list(title = "",
                 titlefont = list(size = 10),
                 tickfont = list(size = 12),
                 gridcolor = "#c8cdc6",
                 showgrid = TRUE,
                 showline = FALSE,
                 showticklabels = TRUE,
                 tickcolor = "",
                 ticks = "",
                 zeroline = TRUE,
                 rangemode = "tozero",
                 automargin = TRUE,
                 autorange = TRUE,
                 fixedrange = FALSE),
    hovermode = "x unified",
    legend = list(
      title = list(text = "Ethnicity"),
      orientation = 'h',
      # Centered at x axis
      xanchor = "center",
      x = 0.5,
      # Place on the top
      y = 1,
      font = list(size = 14)
    ),
    plot_bgcolor = "#eff5ee",
    paper_bgcolor = "#eff5ee",
    margin = list(l = 10, r = 10, b = 10, t = 50, pad = 10)
  ) |>
  plotly::add_annotations(
    x = 0,
    y = 1,
    xref = "paper",
    yref = "paper",
    yanchor = "bottom",
    text = "Total Live Birth",
    showarrow = FALSE,
    font = list(size = 15)
  )

plot

https://jauntyjjs.github.io/rugs_20241129

Current Output

Deploy using Github pages

A preview of the completed dashboard

https://jauntyjjs.github.io/rugs_20241129

Summary

This introduction has covered

Pictures of Quarto navigation bar, pages, layouts, cards and tabsets

https://jauntyjjs.github.io/rugs_20241129

Summary

Other features (not covered)

Pictures of Quarto sidebar and toolbar

https://jauntyjjs.github.io/rugs_20241129

Learn more

https://jauntyjjs.github.io/rugs_20241129