7  Gradient fill in columns

In Section 3.4, we used conditionally formatting to include information about number of observations behind δ13C values in the table (Table 3.1). We can very easily go further than this and use cell fill colour to draw attention to range of values in a column (Section 7.1) or to differentiate among discrete variables (Section 7.2).

We will start by recreating a “basic” table with polished column labels and spanner. We will subset the summarized data (veg_summarized) a bit, mainly to avoid a too long table - we will drop all plant families with less than three observations.

basic_table <- veg_summarized |>
  # rows with non-NA SD values have at least three observations
  filter(!is.na(sd_d)) |>
  gt(process_md = T) |>
  # replace default NA values with a "-"
  # Note: modifying the data with {dplyr} functions would work equally well but {gt} has a devoted function for this purpose
  sub_missing(columns = "sd_d", missing_text = "-") |>
  tab_style(
    style = list(
      cell_text(style = "italic")
    ),
    # family names in italics
    locations = cells_body(columns = "family")
  ) |>
  # ^13^ is markdown for superscript, &delta is html for lower case Greek delta
  tab_spanner(columns = contains("_d"), label = md("&delta;^13^C")) |>
  cols_label(
    family = "Family",
    country = "Country",
    type = "Type",
    n_plants = "Observations",
    mean_d = "Mean",
    sd_d = "SD"
  ) |>
  fmt_markdown(columns = c("type")) |>
  fmt_number(columns = c("mean_d", "sd_d"), decimals = 2) |> 
  # among others bold column and spanner labels
  paper_gt_theme() |> 
  tab_options(table.width = px(800)) |> 
  cols_width(matches("country") ~ px(275))
Family Country Type Observations
δ13C
Mean SD
Balinitaceae Kenya C3 2 −28.60 0.85
Boraginaceae Kenya C3 2 −25.50 0.85
Burseraceae Kenya C3 3 −28.70 1.92
Caesalpiniaceae Democratic Republic of the Congo C3 2 −32.35 1.91
Capparaceae Kenya C3 4 −27.68 2.23
Euphorbiaceae Kenya C3 2 −27.25 0.21
Flacourtiaceae Democratic Republic of the Congo C3 2 −34.85 0.78
Gramineae Argentina C3 24 −27.62 1.84
Gramineae Kenya C4 55 −12.11 1.07
Gramineae Mongolia C3 5 −24.82 1.60
Leguminosae Kenya C3 16 −27.03 1.69
Malvaceae Kenya C3 2 −26.85 1.77
Maranthaceae Democratic Republic of the Congo C3 2 −36.35 0.21
Palmae Kenya C3 2 −25.90 1.56
Rhamnaceae Kenya C3 2 −27.40 1.98
Salvadoraceae Kenya C3 6 −27.15 1.35
Solanaceae Kenya C3 2 −27.50 0.57

There are many great resources related to colours and colour palettes (e.g., Color Palette Finder by Yan Holtz, or a recent blog by Nicola Rennie). For the sake of this tutorial, we will use HCL palettes from the {grDevices}. There are over 110 qualitative, sequentinal and diverging palettes in this collection. (HCL-Based Color Palettes) which makes it a great starting point.

7.1 Continous variables

Mean δ13C and SD

With use data_color() function from the {gt} package as below. data_color() applies provided colour pallette to individual colours and it is therefore safe to provide multiple columns at once.

preformat_table <- basic_table |> 
  data_color(columns = c("mean_d", "sd_d"),
             method = "numeric",
             palette = "Greens")
Family Country Type Observations
δ13C
Mean SD
Balinitaceae Kenya C3 2 −28.60 0.85
Boraginaceae Kenya C3 2 −25.50 0.85
Burseraceae Kenya C3 3 −28.70 1.92
Caesalpiniaceae Democratic Republic of the Congo C3 2 −32.35 1.91
Capparaceae Kenya C3 4 −27.68 2.23
Euphorbiaceae Kenya C3 2 −27.25 0.21
Flacourtiaceae Democratic Republic of the Congo C3 2 −34.85 0.78
Gramineae Argentina C3 24 −27.62 1.84
Gramineae Kenya C4 55 −12.11 1.07
Gramineae Mongolia C3 5 −24.82 1.60
Leguminosae Kenya C3 16 −27.03 1.69
Malvaceae Kenya C3 2 −26.85 1.77
Maranthaceae Democratic Republic of the Congo C3 2 −36.35 0.21
Palmae Kenya C3 2 −25.90 1.56
Rhamnaceae Kenya C3 2 −27.40 1.98
Salvadoraceae Kenya C3 6 −27.15 1.35
Solanaceae Kenya C3 2 −27.50 0.57

The process was straightforward with the first selected palette Greens, which is a ColorBrewer palette.

Observation counts

We will use a red-ish, HCL pallette for values in the column with number of observations: BurgYl.

preformat_table |> 
  # per-column cell fill
  data_color(columns = "n_plants",
             method = "numeric",
             palette = "BurgYl")
Error in `data_color()`:
! An invalid color name was used ("burgyl").
• Only R/X11 color names and CSS 3.0 color names can be used.

However, this time the palette’s colour are not accepted right away. The reason seems to be that the BurgYl palette does not come from ColorBrewer (but from rcartocolor). With the hcl.colors() function, we can easily generate HEX codes for any number of colours from a specific column:

hcl.colors(n = 2, palette = "BurgYl")
[1] "#772C4B" "#F8DFC1"

I decided to set n to 2 to pick the colour from each end of the palette and let data_color() to the rest when filling cell backgrounds.

In the “Mean” and “SD” column, the darkest tone is used for highest values. For consitency in the “Observations” column, we can simply reverse the order of the obtained colous.

final_table <- preformat_table |> 
  # per-column cell fill
  data_color(columns = "n_plants",
             method = "numeric",
             # light to dark for min to max
             palette = rev(hcl.colors(2, palette = "BurgYl")))
Table 7.1
Family Country Type Observations
δ13C
Mean SD
Balinitaceae Kenya C3 2 −28.60 0.85
Boraginaceae Kenya C3 2 −25.50 0.85
Burseraceae Kenya C3 3 −28.70 1.92
Caesalpiniaceae Democratic Republic of the Congo C3 2 −32.35 1.91
Capparaceae Kenya C3 4 −27.68 2.23
Euphorbiaceae Kenya C3 2 −27.25 0.21
Flacourtiaceae Democratic Republic of the Congo C3 2 −34.85 0.78
Gramineae Argentina C3 24 −27.62 1.84
Gramineae Kenya C4 55 −12.11 1.07
Gramineae Mongolia C3 5 −24.82 1.60
Leguminosae Kenya C3 16 −27.03 1.69
Malvaceae Kenya C3 2 −26.85 1.77
Maranthaceae Democratic Republic of the Congo C3 2 −36.35 0.21
Palmae Kenya C3 2 −25.90 1.56
Rhamnaceae Kenya C3 2 −27.40 1.98
Salvadoraceae Kenya C3 6 −27.15 1.35
Solanaceae Kenya C3 2 −27.50 0.57

7.2 Discrete variables

For dicrete variables (factors), the data_color() function works very similarly, we only need to set method to factor:

basic_table |> 
  data_color(c("type"),
             method = "factor",
             palette = c("#FDC718FF", "#3E938BFF"))
Family Country Type Observations
δ13C
Mean SD
Balinitaceae Kenya C3 2 −28.60 0.85
Boraginaceae Kenya C3 2 −25.50 0.85
Burseraceae Kenya C3 3 −28.70 1.92
Caesalpiniaceae Democratic Republic of the Congo C3 2 −32.35 1.91
Capparaceae Kenya C3 4 −27.68 2.23
Euphorbiaceae Kenya C3 2 −27.25 0.21
Flacourtiaceae Democratic Republic of the Congo C3 2 −34.85 0.78
Gramineae Argentina C3 24 −27.62 1.84
Gramineae Kenya C4 55 −12.11 1.07
Gramineae Mongolia C3 5 −24.82 1.60
Leguminosae Kenya C3 16 −27.03 1.69
Malvaceae Kenya C3 2 −26.85 1.77
Maranthaceae Democratic Republic of the Congo C3 2 −36.35 0.21
Palmae Kenya C3 2 −25.90 1.56
Rhamnaceae Kenya C3 2 −27.40 1.98
Salvadoraceae Kenya C3 6 −27.15 1.35
Solanaceae Kenya C3 2 −27.50 0.57

7.3 Including a legend

I have created a couple of tables with gradient fill for my colleagues lately and it turned out to be confusing to identify the gradient’s direction for some of them. Thus, I am using this tutorial as an opportunity to find a way how to include a little legend in a table. It is indeed possible and requires only a few steps to create a legend as a ggplot object. Unlike with plots in Chapter 5, controlling exact placement became an issue, which I could solve only with a bit of CSS.

First, we will create a dummy plot, which will be the source for our legend.

dummy_df <- data.frame(x = c("A", "B", "C"),
                       y = c(1, 2, 3),
                       fill_value = c(1, 50, 100))

dummy_plot <- ggplot(dummy_df, aes(x = x, y = y)) +
  geom_tile(aes(fill = fill_value)) +
  scale_fill_gradientn(colors = rev(hcl.colors(2, "Greens")),
                       breaks = c(1, 100), labels = c("min", "max")) +
  theme(legend.position = "bottom",
        legend.title = element_blank(),
        legend.ticks = element_blank())

dummy_plot

From there, we can continue with isolating the legend only and converting it into a ggplot object. There are couple of options to do so. Here, we will use functions from the {ggpubr} package.

library(ggpubr)
as_ggplot(get_legend(dummy_plot))

In Chapter 5, the text_transfrom() function ({gt}) was introduced already. We can use it to replace a (placeholder) text with a ggplot object - here, our legend. For that, we need to wrap the code for legend isolation into a devoted function.

MakeLegend <- function(dummy_df){
  dummy_plot <- ggplot(dummy_df, aes(x = x, y = y)) +
    geom_tile(aes(fill = fill_value)) +
    scale_fill_gradientn(colors = rev(hcl.colors(2, "Greens")),
                         breaks = c(1, 100), labels = c("min", "max")) +
    theme(legend.position = "bottom",
          legend.title = element_blank(),
          legend.ticks = element_blank(),
          legend.margin = margin(0, 0, 0, 0),
          legend.key.height = unit(120, "pt"),
          legend.key.width = unit(225, "pt"),
          legend.text = element_text(size = 70),
          plot.margin = margin(0, 0, 0, 0))
  
  fill_legend <- as_ggplot(get_legend(dummy_plot))
  
  return(fill_legend)
}

The most naive approach is to call the MakeLegend() function and pass its output to ggplot_image() as we have done in Chapter 5. It turns out our function did create an output but is an HTML string.

final_table |> 
  tab_footnote(footnote = MakeLegend(dummy_df) |> ggplot_image(height = 50, aspect_ratio = 6))
Table 7.2
Family Country Type Observations
δ13C
Mean SD
Balinitaceae Kenya C3 2 −28.60 0.85
Boraginaceae Kenya C3 2 −25.50 0.85
Burseraceae Kenya C3 3 −28.70 1.92
Caesalpiniaceae Democratic Republic of the Congo C3 2 −32.35 1.91
Capparaceae Kenya C3 4 −27.68 2.23
Euphorbiaceae Kenya C3 2 −27.25 0.21
Flacourtiaceae Democratic Republic of the Congo C3 2 −34.85 0.78
Gramineae Argentina C3 24 −27.62 1.84
Gramineae Kenya C4 55 −12.11 1.07
Gramineae Mongolia C3 5 −24.82 1.60
Leguminosae Kenya C3 16 −27.03 1.69
Malvaceae Kenya C3 2 −26.85 1.77
Maranthaceae Democratic Republic of the Congo C3 2 −36.35 0.21
Palmae Kenya C3 2 −25.90 1.56
Rhamnaceae Kenya C3 2 −27.40 1.98
Salvadoraceae Kenya C3 6 −27.15 1.35
Solanaceae Kenya C3 2 −27.50 0.57
<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAC7gAAAH0CAYAAACt/2AgAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBIWXMAAA9hAAAPYQGoP6dpAAAgAElEQVR4nOzdW4xe1XkG4NdgG8qEBJIGREggSsDGIpVVUgXf5KbQXlARKaSImwSFcqrrooAlDpXKTZFCsNXUkYgMOCptuSFtIqQGKFVJ00qthLG4QFWFMDWSbSqDBRgMPoDx/L0Y0xDP3jNrz/rHsxw/j2RpvA/rW/u09t4z7/yTAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMCYLVroDgAAwPHm0KGDl08uys0ly44y2TWxWMfa3Q10luleu7zJso52LjU5oHbX6l2tdk4qr1PepXmoXVpn0OlStvCxOofKd2/5BdBZv2xSSo/jDJM7TK/UWXuychuLj2Nt7c4GymoPOo5FZfomdposrF9zbPu6U3q+dXfx2IxZA24zyajwmHfVqRvqq2oPWqpjZ9bcEvoqVV1T3RdabZcq+jNkGyvqDDtZp08pPJCTfUe8cGcO6ua04t21S8/BUfF421On6jodsC86711zLz4acD/rbmD6pNL+jCof1ou3e0CZzj4VPzcOuXLr3l2mr9qzcvFtt6w//V2ce+e7r50Bd6nCicXbXfdqV7xk/6U3vQPljzoDzsGK+9mQo935vln+wD29duWQNVkx5tW+95eflz1NVjzzdl9ndTtz7O9XPQ2UPweXj6tjfw6ufefqLFT5nFQz/g/Qef8pPg/Kx+Cqt+Ka/gyp3TG+DNq7xffdmuu+u9Wq9/nK67702WvQ+Vu4QaXPooO2p2I86L9FjTq+KqxS+JIyuN2j1y28Qfe39cs5o+mTZll/eu3PfvqcB7/3R3c/XdQpAAAgSbJ4oTsAAADHm9FJueLw5Ad/OG165w/6ukKPQ4K3ZeuX1+6u0/1Dypo6PfGa0iBZ1TYuXO3+9StqV9bp/sFu+7X71l/QOqX76ATdxv71G6vT2eaQfXmM6hSeB+W1u9WMraV1+rexblwff53OlYvWXfA6Y77PzMu9dMBzSc31UzyGHqs6Cz4ul9Yu3RedZY7J9TzkHtc9qW5s6z79x3/+1z2fdrTW/wJQWKdrzcLnkt5rr2va3M/BYeNlxTk4ZCypOQfL04SV59uQ8b/sfCt/r+wsU/e8Xdhef5tz70/1s9eY929/nc4l596fnmWLr93ae1xhf2r2b1+f6t7ZOssck/tmb3C2aszq7FB3mbG/L3aWGXDP7167ZN2+8jV9H3bv6WpyHsbLYzX+H4NjNmQcq7nu5+ddqqu9yjFrjMds9JEvjl68Ziw5erlf1pneauf/O5er3cbZa08tNn3qTVd8a2cSAXcAABjgpIXuAAAAAAAAAAAAAAAAJALuAAAAAAAAAAAAAAA0QsAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANAEAXcAAAAAAAAAAAAAAJog4A4AAAAAAAAAAAAAQBME3AEAAAAAAAAAAAAAaIKAOwAAAAAAAAAAAAAATRBwBwAAAAAAAAAAAACgCQLuAAAAAAAAAAAAAAA0QcAdAAAAAAAAAAAAAIAmCLgDAAAAAAAAAAAAANCExQvdAQAAON4sysm7T+76VdFR16SuiR3TenQtOepav2Na57q9hcr61Lk9HdP6muuePvc2u/dvT+3SqcX7snwjSw95b5udZcq2vbTNzvbK91r5sR3Ux9LzoLRD49+e4to9J0FVLweca+XnQWHtvl5WHJ/q87+wPzVjTt/a3evXXHsDaneeB5VtFm5PcZW+87/4Oqs53t0zavre15/yfVlap7dTZW12rlq2Pf3PC4X9KR4ve8qUb1DHul1LDbmgC7en/CSqKd1z7ZVf46X33eI2K49Z1XNJ7T2u+rmks9Hpk2qPWVeZirF+yFhS+mhd/Y5TvN/n3se+QuXDZd2zZM274aCzpfTd5Vg941U+Z1W9z3RO7OtlzblV9+zV2WLpeTDgZjrkXXnO/elvoaPNrqWKO1RYpXvZ4jN9Acex/slzv2+WX/fl/Sk+14ccs8I683MvLV67fGrF9Vx8DnWXqTyHymcUj40DutP9vD33Y177Tlzz3Dis2+N/xivue+VzcF+do6fWjdX9A+ZsPR3N3MJs3elfe1TYZse0i89btrtgVQAA4CME3AEAYKDFJy3e5lEaAAAAAAAosO07uXmh+wAAAMeVrs+dBAAAAAAAAAAAAACAY07AHQAAAAAAAAAAAACAJgi4AwAAAAAAAAAAAADQhMUL3QEAAPh1tmHDhmzfvr13/jXXXJNVq1Ydwx4BAAAAAAAAAEC7BNwBAGAePfroo9m8eXPv/IsvvljAHQAAAAAAAAAAjjhpoTsAAAAAAAAAAAAAAACJgDsAAAAAAAAAAAAAAI0QcAcAAAAAAAAAAAAAoAkC7gAAAAAAAAAAAAAANEHAHQAAAAAAAAAAAACAJgi4AwAAAAAAAAAAAADQhMUL3QEAAPh19swzzyx0FwAAAAAAAAAA4LjhE9wBAAAAAAAAAAAAAGiCgDsAAAAAAAAAAAAAAE0QcAcAAAAAAAAAAAAAoAkC7gAAAAAAAAAAAAAANEHAHQAAAAAAAAAAAACAJgi4AwAAAAAAAAAAAADQBAF3AAAAAAAAAAAAAACaIOAOAAAAAAAAAAAAAEATFi90BwAAOKEsSfL7Sb6a5MtJvpDkE0f+vZ/knSRvJHkhyX8l+ackz1bW/J0klye5JMmXkpx5pN7SJAeSvJ5ke5Lnk/x7kn9Osq+yZvPefffdPPXUU9myZUuef/75bNu2LXv37s3evXtz6NChnHrqqTnjjDPymc98JsuWLcsll1ySyy67LCtXrlzorgMAAAAA0JjDhw/nxRdfzMsvv5ydO3fmjTfeyMGDB3PgwIEsXrw4p5xySiYmJnL22WfnnHPOyYoVK3LeeedV1dy5c2e2bt2aV155Jbt27cr+/ftz8ODBHD58OEuWLMnExETOPPPMnHvuufniF7+Yiy66KEuXLh3TFg/2G0k+n+S8JGcl+WSSjyU5LVM/O1mcZDLJB0kOJtmbZE+SV5PsTPI/R6YDAMAJYdFCdwAAgOPKD5P8Sc+8d5J8vGfemUn+LMl1SX5zYM3tSdYl2ZTkUOE6pyRZfeTfsoH19iV5OMk9SXZ3LTAaja5O8vclja1atSqbN2/unb9p06bccMMNgzp46aWX5tlnu3P/p59+evbu3du77pYtW7Ju3bo88cQTOXDgwKC6SXLhhRdm9erVWb16dU499dTB6wMAAAAA0J6bbropmzZt6pw30/ed9+zZk3vvvTcPP/xwXn/99UE1zz///Nxxxx258cYbs2TJkqJ13nvvvWzcuDEbN27M1q1bB9WbmJjIddddl7vvvjtnnXXWoHXn4u23384jjzyS7373uy/s2rVreZKTKpo7nOTfkvxdkkcz9aFBNU5O8h9JVs2wzChTH1j0n5W1+nwqUx949OkZltmX5LeTvDRPfQAAoFE1D88AAJx49s8w72Pp/gXKb2Xqk0Vuz/Bwe5Kcn6lg/fMpC6v/QZIXk/xV4fJHm0jyp0m2JvnGHNafdx//eN/vEUx9MvtoNJo2/dVXX81VV12Vr3zlK/nJT34yp3B7krz00ktZu3Ztli9fnl/84hdzagMAAAAAgLZMTEz0zuv7vvMjjzySCy64IOvXrx8cbk+S7du3Z82aNVm5cmVRWP2JJ57I8uXLc9tttw0OtyfJvn37cv/992fZsmX56U9/Onj9Unv27Mmdd96Zc889N7fcckt27dq1IvX5nJOTXJbkb5Nsy9QHCtV8qOXhJN9M8u4MyyxK8qNMfajQfPh+Zg63J8naCLcDAJyQBNwBABhipj9/uShT4fCP/n9Dpj5N5JNjqL0iyeYkX56h/veS/CxTofhan0jyD0n+eAxtjdVpp53WO280GmXfvn2/Mu3nP/95Vq5cmccee2xsfdixY0cuv/zyPPTQQ2NrEwAAAACAhTHTX+w8+vvOo9Eot956a6699tq8+eab1bVfeOGFXHrppXnuued6699111258sors3379up6b7/9dq6++uo88MAD1W0d7fHHH8+KFSuybt26ad+rH6PPJvnrJP+S2QPiM9mW5LZZlrkoyZ9X1Ojze0munWWZnyXxQwgAgBOUgDsAAEPM9icvT//I199P8p0x1z8jyWNJuv526A+T3Jm6Tyw52qIj7V4+xjarzfSDhiR55513/v/rJ598MldccUV279499n5MTk7m5ptvzo9//OOxtw0AAAAAwLGzdOnSGed/9PvOa9euzQ9+8IOx1n/rrbfy9a9/vfN72WvWrMl9993X+SnyczUajbJmzZo8/fTTY2vzvvvuy9e+9rW89tprY2tzFpcleTbJ5yva+FGSf5xlmTuT/FZFjaOdlmS23y7YneSGMdYEAOA4I+AOAMAQh2aZ/2HA/eYkt85THz6XZP1R0+5Osnqe6p2U5G8y9Q3XJpxyysx/DfTDHzRs3rw5V111Vd5/f7bfS6hz/fXXZ8eOHfNaAwAAAACA+bNkyZIZ53/4fecHH3wwGzZsmJc+7Ny5M7fffvuvTLvnnnuycePGeak3OTmZb3/729m/f391W+vXr89dd9011hB+oc8n+dckn6po44YkM6Xyl2QqCD+ujNFfJPnCLMtcn6mQOwAAJygBdwAAhvhglvkfS3JBkr/smPe/Se5N8rtJzkmy9Mjyn0vy1Uz9icv/LuzHN5N86cjXX83/tXfvUVKXZ57Av80toICBaCACQdeoM6h4OdnVeFzjYFwvOdE1GqKOGlExrhudjc4i2cgaEolzBjSzxhvxNhpNosyuZ3GOiSHxRGHWC0u8EY0GjUaIAsoKae7QvX8UTrj1r37VXUU3zedzTh2bep56nrfxL6u+vpVcu52e1anc9n5OktGpfE1nnyRDNr324iT/M0lLiX3Dknyt5NkartoHDc3NzXn//fczduzYrF27dpv6PvvskwkTJuTRRx/N73//+zQ3N2f9+vV5//3388Ybb+Sxxx7L5MmTc8QRR5Q6z8qVK3P11Ve363cBAAAAAKDz9erVq7De3NycBQsW5KqrrtqmNmzYsHzjG9/I448/nnfeeSfr1q1Lc3Nz3n777cyePTvXXXddDjrooFLnuP/++zN//vwkyezZszN58uRtevr165fTTz89P/rRj/Liiy9m6dKlWbduXRYvXpz58+fnzjvvzBlnnJEePapHYhYtWpSbb7651NnaMmvWrEycOLFs+6Ikd6TyOcdRqXxeMiBJryR7JBmZyuce/zXJz5OUSczvm+T+2k69haWpBMqL/LskV3Rgx4eOSPULkm5P8s912AUAwE6sqbMPAADATuXrSW4sqH8YNv/cZs+tS3Jdkr9L9Rvge6TyJuqtqbyZW+T7qbzB+5sk+21V+6cklyd5t8qMpBJ+/3GSUVX63krlRpGW1tbWLyV5qMTsHHXUUXnmmWfarN9xxx25+OLavmXz0ksvzfTp09usz549O7fcckt+8pOfbPH80KFDc/311+crX/lKmprK/afAz372s4wbNy7vvlv8V9mzZ88sWLAg++yzT6m5AAAAAAB0HdOmTdvm9vTNfRg2/8UvfvGvz/Xp0yfXXHNNJk6cWPVilpaWltx111257LLLsmFD8V06l19+eaZOnZqDDjoor7/++ha1M888M9///vczdOjQqr/Tiy++mLPPPjsvv/xyYd/IkSPzxhtvlArEb2316tUZNWpU3nzzzWqtHyS5Osk9qf5Zyeb+Isn3kpxUovfsJD+p2tW221P5ht62rEzlAqE32zm/V5Jnkxxe0PPapnrHr9UHAGCn5gZ3AABqUe0G9y9ly3D70iT/Nsl3Uu4N25b8+eaSasamEnDfPNzemuTCTecoE25PkheTHJ/k91X6RqZym0qnq/ZBwcyZM7cJt59xxhl57bXXcsEFF5QOtyfJSSedlDlz5mTEiBGFfRs3bsz993fkghgAAAAAADpLtRvcZ8yYsUW4fa+99srcuXMzadKkqu9ZJ0mPHj0yfvz4Uu8jP/TQQ5k6deoW4fampqbcfffdmTFjRqlwe5KMHj06v/zlL7PvvvsW9r311lt5+umnS83c2r333ls13L777ru/n+QzSX6Q2sLtSfLbJJ9PMq1E77fTsYsur0zyu4L67qmE4DsyvyjcviGVz4eE2wEAEHAHAKAmLVXqm3895f9LckIqAfJaPZhkZpWeIakE5zf31VRuP6nVu0m2/V7VbZ3cjtl1V+0WmalTp27x5wsvvDAPPvhgBrlDmBsAABZSSURBVAwY0K59++23X6mvaJ05s9q/MgAAAAAAuqJqF6PcdNNN//rzoEGDMmvWrIwePbrmPV/+8pdz6qmnFvYsXrw4kyZN2uK56dOnZ9y4cTXvGzp0aG644YaqfT/96U9rnp0kt956a2G9Z8+emTRp0j+kElRvr5YkE5I8WqVv/5S76b0tq1IJmBdddnRikvPbMXu/JN+q0jM5ydx2zAYAoBsScAcAoBatNfRemuSFDuyaXGP/j1K5/b29Hk71MP6RHZhfN7V8Tepxxx2XO++8Mz179uzQzlNPPTXHHntsYc9zzz2XlStXZuPGjR3aBQAAAADAjlXL+8633357Dj300Hbvuvbaa2vqP+ecczJ+/Ph27zv99NOrhvGfeeaZmuc+++yzeemllwp7zj333Fx99dWv1jx8W62pXPJT7Q34sR3c82y2vVxoazcm2avGudOT9Cuo/58k19c4EwCAbkzAHQCAWlS7wf1Djyd5qIO7fp1kUcneFUn+toP7kuSRKvXD6rCjw8qG1fv375977rmn6s07ZY0dW/y++IYNG/LCCy+kubm5LvsAAAAAANgxygbcx4wZU/W94mqOOOKIDBs2rFTvwIEDM23atA7tS5IvfOELhfXnn3++5pmPP/541Z6vfvWrNc8tsDDVP8c4oQ57piR5uqD+sSQ3FdS3Ni7J8QX1PyU5L9XD+wAA7EIE3AEAaIRv1mnOrJJ9dyR5Zwfs2yvJwDrs2SEmTJiQffbZp27zTjvttKo9r776alatWlW3nQAAAAAAdB1Tpkypy5wTTiiXwx4/fnw+8YlPNHzf0qVLs2LFippmzpkzp7Dev3//HHXUUTXNLOF/VakPS7J3B3dsTCVwvrKg56wkny8x6+NJqv0fCn+T5I1yRwMAYFfRq7MPAABAt/Naim/2qEXxd3v+2X07cN/wOu1qqN69e+eSSy6p68zhw4dnyJAhWbx4cZs9f/jDH7JmzZq67gUAAAAAoPMdcMABdQtsH3LIIaX6zj///B22b+HChRk1alTpmRMnTsxZZ52VJUuWZPHixds8DjzwwLp9w+pm5pXo2T/JHzu4Z0GSryf5QUHPbUkOSuUG9rbclGRwQf3hJPfUfDoAALo9AXcAAOrth3Wc9VaJnvlJXqzTvmVJmpP0L+jZs067GuqLX/xihgwZUve5n/rUpwoD7kuXLs26devqvhcAAAAAgM513nnn1W3WyJEjq/YcfPDBGT16dF32DR48OP37909zc3ObPe+9915NM4855pgcc8wxHT1arX6bZF2SPgU9I+q0644kX9j0aGvP9Um+1kb980m+XDD/nSTj2306AAC6tR6dfQAAALqdX9Vx1rsleoq/A7T+OwfWeV9DnHzyyQ2ZO3x48QX2y5cvz4YNGxqyGwAAAACAznPcccfVbdbQoUOr9tQ7PF5t54oVK+q6r0Fakiyv0jOgjvsuTrKkoH5ZkqO383z/JLdWmT0uyfvtPBcAAN2cgDsAAPXUmuSFOs4r+lrLDz1Xx31ldhbditJl1OtrYrc2aNCgwvratWvT0tLSkN0AAAAAAHSOpqamHHrooXWbN2BA9Qz24YcfXrd9ZXbuRN9OWi2J36+Ou5Ykuaig3pTkzmz72cl3k3yy4HU3J3msY0cDAKA7E3AHAKCefpdyofSy1pToeb6O+8rs7F3nfXU3aNCgHHDAAQ2Z3a9f8fvi69evT2tra0N2AwAAAADQOfbff/9SofSy+vbtW7XnsMMOq9u+MjvXr19f130N1FylXu8s0D8n+UFB/S+TXLPZn49M8p8L+l9JMqEO5wIAoBsTcAcAoJ4W1nlemXeT/7iDdzbVeV/djRw5Mk1NjTlm797F+X7hdgAAAACA7mf48OF1nVftveYk2XvvvXfoTu9vF7oylUuO2jIxycGpXBJ0Z9rOI61P8tdJVtf1dAAAdDsC7gAA1NPyOs8r825yta/ibMTOLm3QoEENm92o4DwAAAAAAF3XHnvsUdd5Zd5rHjhw4A7fSZtWJjk3yYY26h8G2/9bKkH3tvz3JM/V92gAAHRHvTr7AAAAdCv1DptX05rkTzt4Z5fXyIA7AAAAAAC7nnqHzatpamrKgAEDdujOBts9yac2e3wyyUc3e/RPJcPTe9M/i37uuYPP/qFnk1yX5Ftt1I/c9GjLk0n+vs5nAgCgmxJwBwCgnpp38L5V6QY3rtdbN3vTHwAAAACATta/f/8dum+33XbbqW9cX7NmTWbNmpVHHnkkM2bM+F6SB5PsvL/Qn01JcnKKg+zbsyLJ+Ula6n4iAAC6JQF3AAAAAAAAAADooHfeeSc33nhj7r777ixbtuzDp4d15pnqbEOSc5M8n8qt9GV9LclbDTkRAADdkoA7AAAAAAAAAAC00/r16zNlypRMnTo1q1at6uzjNNqCJFcmmV6y/6EkP2zccQAA6I4E3AEAAAAAAAAAoB0WLVqU0047LfPmzevso+xIP0hyepKTqvQtT3Jp448DAEB306OzDwAAAAAAAAAAADub119/PZ/5zGd2tXB7kgxM8pcl+vZI8rkGnwUAgG7IDe4AAAAAAAAAAFCDZcuW5ZRTTsnbb79d60tfT/JskjeTLEzyTpLmTY+VSdZv9li3nZ//b5JDO/4bdMjNSUaW7L09yb8k+WPjjgMAQHcj4A4AAAAAAAAAADW49NJL89prr5VtfzmVUPg/JVnasEPtGGckOa+G/sFJ/jHJiUlaG3EgAAC6nx6dfQAAAAAAAAAAANhZPProo5kxY0bVvv79++e88867JclBSW7Lzh9uH5pkejted0KSK+p8FgAAujEBdwAAAAAAAAAAKOnb3/521Z4RI0Zk3rx5ue+++57YAUfaUe5K8rGCektB7e+SjKrvcQAA6K4E3AEAAAAAAAAAoIT58+fnmWeeKezp06dPZsyYkQMOOKARR9i9EUNL+E9JTimo/yrJhIJ63yQPJOlTxzMBANBNCbgDAAAAAAAAAEAJjzzySNWeSZMm5cgjj2zUET7RqMEF9k8ytaC+MslFSb6X5OmCvsOSfKeO5wIAoJsScAcAAAAAAAAAgBKefroov5307ds3V1xxRaPWfyw7/gb3nkl+WGXvN5K8kaQlyYVJ1hb0/m2SY+t2OgAAuiUBdwAAAAAAAAAAKOGVV14prB933HEZOHBgo9b/VaMGF/hmkqLr6GcnuXmzP7+SZHJBf48k9yXZo+NHAwCguxJwBwAAAAAAAACAEhYuXFhYP/zwwxu5/sRGDt+OTyeZVFBfneSiJK1bPT81ybyC143MlqF4AADYgoA7AAAAAAAAAABU0dLSktWrVxf2jBgxolHrd09yeqOGb0e/JPcn6VXQc02S323n+Q1JLkyyvuC15yYZ2+7TAQDQrQm4AwAAAAAAAABAFevXF+W1K3bbbbdGrb8kyccaNXw7piY5sKD+VJJ/KKi/mOS7VXbcnmRYjecCAGAXIOAOAAAAAAAAAABVfOQjH0nfvn0Le5qbmxuxevckVzVicBv+Q5LLCuprUrmhvaXKnClJXiqoD0pyb5Kmmk4HAEC3J+AOAAAAAAAAAAAlDB48uLC+ZMmSRqy9OeVvOu/TwV2Dk9yT4tD5tUl+W2LW+iTjkmws6Dk+yd+UPh0AALsEAXcAAAAAAAAAAChhyJAhhfWnnnqq3ivPTnJBDf0DOrjvtiR7F9SfTXJDDfPmJZlapef6JAfXMBMAgG5OwB0AAAAAAAAAAEo48sgjC+tz5szJe++9V691xyW5a6vnlld5zSc7sO+vk4wtqK9L9RvZt+dbKb7xvW+S+9Px2+cBAOgmBNwBAAAAAAAAAKCEz372s4X11atXZ9q0afVYNTbJo0n6bfbck0mqDT+8nftGJLm5Ss/kJC+3Y/baJBcmaSnoOTTJlHbMBgCgGxJwBwAAAAAAAACAEsaMGZPevXsX9kybNi0///nP27tiYJLpSR7MluH2dUkuTbKwyuv/Isl+Ne5sSnJPko8W9MxL8vc1zt3cU0n+R5WeK1O5tR4AgF2cgDsAAAAAAAAAAJTw8Y9/POecc05hz8aNG3PqqafmjjvuyMaNG5tKjt4jlYD360ku2U79m0leSbKgypymJN8pufND/yXJ8QX19UnGJdlQ49ytXZPK79eWHknuTeXvAgCAXZiAOwAAAAAAAAAAlDRhwoQ0NRXn1teuXZtLLrkke+655w1Jrkry6SR7JemVys3sQ5Icncqt7DOS/DHJDUn23M64mUmmbfr516keND9708yjkvRP0ifJsCSHbKd3VJLvVpl3XZKXqvSUsSrJRUlaC3o+meTWOuwCAGAnJuAOAAAAAAAAAAAljRo1KhMmTCjV+8EHHwxPJZw+N8mSVG5DX5Xk3ST/kuS2JGcm2a2NEc8mOW+zP69K8lSJ1Wdu6vtTkrVJFiaZulVP7yT3J+lbMOeFJNeX2FfWE0lur9JzTpKz6rgTAICdjIA7AAAAAAAAAADUYMqUKTn22GMbvWZekhOTrNjq+X+s0/zJSQ4vqG9IMi6VUH49TUjyVpWe25IMr/NeAAB2EgLuAAAAAAAAAABQg549e+bhhx/OmDFjGrXiriT/PskH26k9kOTVDs4/OpWgeZHrkzzXwT3b05xkfJWejya5N0lTA/YDANDFCbgDAAAAAAAAAECNBg8enMceeyyXX355evSoWwTn5ST/McnFSVa30bM2yQWpBMXbo3+SHybpWdAzP8l17Zxfxqwkd1fpGZPk6w08AwAAXZSAOwAAAAAAAAAAtEOvXr1y00035Te/+U3OP//89OrVqz1jNib5RZJzkxyS5H+XeM3TST6XZEE79n0vyb+pcp5xSda1Y3YtrkyyqErPd1P5O9m9wWcBAKAL8TU+AADUYnSS4wvqLyR5vI77Bia5qKC+PsnNddyXJF9KMryg/mhra+voJA+VGfbjH/847777bpv1E044IQcffHBNB3zyySczb968NuujRo3KiSeeWNPMsubMmZO5c+e2Wd9vv/1y9NFHZ88992zIfgAAAAAA6MqWLVuW2bNn54knnsjcuXPz0ksvLVq+fHnvJIOSbEiyYtPjD0meT/JcKuH2xe1c2SvJ2UlOSfLpJHsmGZDK7e7LkyxL5Vb4eUl+leTX7dwDAAA7jIA7AADUqLW19UspGXAHAAAAAAB2HWvWrMmiRYuycOHCLF68ODNnzrzlgQceeClJ3yQtqdyKvi6VkPvSJEtSCbuvaufKHkkOTLJvkiFJ+iXps9meNUne37Tn7U3/BACALk3AHQAAaiTgDgAAAAAAlDS2qalpRmcfAgAAdiY9OvsAAAAAAAAAAAAAAACQCLgDAAAAAAAAAAAAANBFCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAlCLgDAAAAAAAAAAAAANAl9OrsAwAAwE7o+SRXdPYhAAAAAACALu/5zj4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwC7v/wPiJicBBStxMgAAAABJRU5ErkJggg==" style="height:50px;">

If we wrap MakeLegend(dummy_df) |> ggplot_image(height = 50, aspect_ratio = 6) into an html() function, the generated ggplot object is finally displayed correctly.

final_table |> 
  tab_footnote(footnote = html(MakeLegend(dummy_df) |> ggplot_image(height = 50, aspect_ratio = 6)))
Table 7.3
Family Country Type Observations
δ13C
Mean SD
Balinitaceae Kenya C3 2 −28.60 0.85
Boraginaceae Kenya C3 2 −25.50 0.85
Burseraceae Kenya C3 3 −28.70 1.92
Caesalpiniaceae Democratic Republic of the Congo C3 2 −32.35 1.91
Capparaceae Kenya C3 4 −27.68 2.23
Euphorbiaceae Kenya C3 2 −27.25 0.21
Flacourtiaceae Democratic Republic of the Congo C3 2 −34.85 0.78
Gramineae Argentina C3 24 −27.62 1.84
Gramineae Kenya C4 55 −12.11 1.07
Gramineae Mongolia C3 5 −24.82 1.60
Leguminosae Kenya C3 16 −27.03 1.69
Malvaceae Kenya C3 2 −26.85 1.77
Maranthaceae Democratic Republic of the Congo C3 2 −36.35 0.21
Palmae Kenya C3 2 −25.90 1.56
Rhamnaceae Kenya C3 2 −27.40 1.98
Salvadoraceae Kenya C3 6 −27.15 1.35
Solanaceae Kenya C3 2 −27.50 0.57

It is a decent outcome, but the legend’s positioning is not perfect. Can we move it more to the left and reduce the footnote’s height a bit? The only solution I could find was wrapping our call into an HTML division. With this setup, we can then use CSS options to control position of the element. Finding out a suuitable set of settings was a trial and error of various alignment options (great source was W3Schools’s CSS section).

We are combining HTML and CSS syntax with R code (MakeLegend(dummy_df) |> ggplot_image(height = 50, aspect_ratio = 6)) and we need to make sure that it gets interpreted correctly. We will use the {glue} package. Its glue() function is very straightforward to use: we only need to wrap R code into a pair of curly braces ({ }).

final_table |> 
  tab_footnote(footnote = html(glue::glue(
      "<div style='float: left; top: 100%; bottom: 0%; transform: translate(0, -105); margin-left: -10%;'>
         {MakeLegend(dummy_df) |> ggplot_image(height = 50, aspect_ratio = 6)}
       </div>"
    )))
Table 7.4
Family Country Type Observations
δ13C
Mean SD
Balinitaceae Kenya C3 2 −28.60 0.85
Boraginaceae Kenya C3 2 −25.50 0.85
Burseraceae Kenya C3 3 −28.70 1.92
Caesalpiniaceae Democratic Republic of the Congo C3 2 −32.35 1.91
Capparaceae Kenya C3 4 −27.68 2.23
Euphorbiaceae Kenya C3 2 −27.25 0.21
Flacourtiaceae Democratic Republic of the Congo C3 2 −34.85 0.78
Gramineae Argentina C3 24 −27.62 1.84
Gramineae Kenya C4 55 −12.11 1.07
Gramineae Mongolia C3 5 −24.82 1.60
Leguminosae Kenya C3 16 −27.03 1.69
Malvaceae Kenya C3 2 −26.85 1.77
Maranthaceae Democratic Republic of the Congo C3 2 −36.35 0.21
Palmae Kenya C3 2 −25.90 1.56
Rhamnaceae Kenya C3 2 −27.40 1.98
Salvadoraceae Kenya C3 6 −27.15 1.35
Solanaceae Kenya C3 2 −27.50 0.57

7.3.1 Composite legend

In my opinion, the colour scale in the “Observations” column in easy to navigate even without legend because of integer values and their good separation. Nonetheless, we can use the second colour gradient as an opportunity to combine two ggplot objects in a single figure to be used in the gt table’s footnote.

We will modify the MakeLegend() function. It should produced two dummy plots, extract each of the legends and combine them side-by-side. We will introduce two new parameters to the new function - gradient1 and gradient2 - which will take a vector of colours used to create a gradient fill.

library(patchwork)

MakeLegendCombined <- function(dummy_df, gradient1, gradient2) {
  p1 <- dummy_plot <- ggplot(dummy_df, aes(x = x, y = y)) +
    geom_tile(aes(fill = fill_value)) +
    scale_fill_gradientn(
      colors = gradient1,
      breaks = c(1, 100), labels = c("min", "max")
    ) +
    theme(
      legend.position = "bottom",
      legend.title = element_blank(),
      legend.ticks = element_blank(),
      legend.margin = margin(0, 0, 0, 0),
      legend.key.height = unit(120, "pt"),
      legend.key.width = unit(225, "pt"),
      legend.text = element_text(size = 70),
      plot.margin = margin(0, 0, 0, 0)
    )

  fill_legend1 <- as_ggplot(get_legend(dummy_plot))

  p2 <- dummy_plot <- ggplot(dummy_df, aes(x = x, y = y)) +
    geom_tile(aes(fill = fill_value)) +
    scale_fill_gradientn(
      colors = gradient2,
      breaks = c(1, 100), labels = c("min", "max")
    ) +
    theme(
      legend.position = "bottom",
      legend.title = element_blank(),
      legend.ticks = element_blank(),
      legend.margin = margin(0, 0, 0, 0),
      legend.key.height = unit(120, "pt"),
      legend.key.width = unit(225, "pt"),
      legend.text = element_text(size = 70),
      plot.margin = margin(0, 0, 0, 0)
    )

  fill_legend2 <- as_ggplot(get_legend(dummy_plot))
  
  # {patchwork} syntax to combine plots side by side
  combined_legend <- fill_legend1 + fill_legend2

  return(combined_legend)
}
final_table |> 
  tab_footnote(footnote = html(glue::glue(
      "<div style='float: left; top: 100%; bottom: 0%; transform: translate(0, -105); margin-left: 0'>
      {MakeLegendCombined(dummy_df,
      gradient1 = rev(hcl.colors(2, 'Greens')),
      gradient2 = rev(hcl.colors(2, 'BurgYl'))) |>
        ggplot_image(height = 50, aspect_ratio = 8)}
       </div>"
    )))
Table 7.5
Family Country Type Observations
δ13C
Mean SD
Balinitaceae Kenya C3 2 −28.60 0.85
Boraginaceae Kenya C3 2 −25.50 0.85
Burseraceae Kenya C3 3 −28.70 1.92
Caesalpiniaceae Democratic Republic of the Congo C3 2 −32.35 1.91
Capparaceae Kenya C3 4 −27.68 2.23
Euphorbiaceae Kenya C3 2 −27.25 0.21
Flacourtiaceae Democratic Republic of the Congo C3 2 −34.85 0.78
Gramineae Argentina C3 24 −27.62 1.84
Gramineae Kenya C4 55 −12.11 1.07
Gramineae Mongolia C3 5 −24.82 1.60
Leguminosae Kenya C3 16 −27.03 1.69
Malvaceae Kenya C3 2 −26.85 1.77
Maranthaceae Democratic Republic of the Congo C3 2 −36.35 0.21
Palmae Kenya C3 2 −25.90 1.56
Rhamnaceae Kenya C3 2 −27.40 1.98
Salvadoraceae Kenya C3 6 −27.15 1.35
Solanaceae Kenya C3 2 −27.50 0.57