Author: Etienne Bacher - Personal website - Github - Twitter
View the **Table - Code reproducing table - Full Repo
Contrarily to the Shiny contest, I didn't have any idea for this contest as I rarely see beautiful tables that I would like to reproduce, and I don't need to create particularly complicated tables in my work. So I was thinking I would not participate to this, but I tried to search "tables stats" online to see if something inspired me. I stumbled upon a periodic table of elements, and thought it would be a good exercise to reproduce it, as I am not familiar with the gt package. For reference, this is the table I tried to replicate.
So here it is! Nothing complicated, a bit tedious to make, but a nice introduction to this package.
library(dplyr)
library(stringr)
library(gt)
#####################################################################
## Create data for periodic table ##
#####################################################################
elements <- tibble(
rowname = c("1", "2", "3", "4", "5", "6", "7", "", "", ""),
"1" = c("1 H", "3 Li", "11 Na", "19 K", "37 Rb", "55 Cs", "87 Fr", "", "", ""),
"2" = c("", "4 Be", "12 Mg", "20 Ca", "38 Sr", "56 Ba", "88 Ra", "", "", ""),
"3" = c("", "", "", "21 Sc", "39 Y", "57 La", "89 Ac", "", "", ""),
" " = c(rep("", times = 5), "58-71", "90-103", "", "", ""),
"4" = c("", "", "", "22 Ti", "40 Zr", "72 Hf", "104 Rf", "", "58 Ce", "90 Th"),
"5" = c("", "", "", "23 V", "41 Nb", "73 Ta", "105 Db", "", "59 Pr", "91 Pa"),
"6" = c("", "", "", "24 Cr", "42 Mo", "74 W", "106 Sg", "", "60 Nd", "92 U"),
"7" = c("", "", "", "25 Mn", "43 Tc", "75 Re", "107 Bh", "", "61 Pm", "93 Np"),
"8" = c("", "", "", "26 Fe", "44 Ru", "76 Os", "108 Hs", "", "62 Sm", "94 Pu"),
"9" = c("", "", "", "27 Co", "45 Rh", "77 Ir", "109 Mt", "", "63 Eu", "95 Am"),
"10" = c("", "", "", "28 Ni", "46 Pd", "78 Pt", "110 Ds", "", "64 Gd", "96 Cm"),
"11" = c("", "", "", "29 Cu", "47 Ag", "79 Au", "111 Rg", "", "65 Tb", "97 Bk"),
"12" = c("", "", "", "30 Zn", "48 Cd", "80 Hg", "112 Cn", "", "66 Dy", "98 Cf"),
"13" = c("", "5 B", "13 Al", "31 Ga", "49 In", "81 Ti", "113 Nh", "", "67 Ho", "99 Es"),
"14" = c("", "6 C", "14 Si", "32 Ge", "50 Sn", "82 Pb", "114 Fl", "", "68 Er", "100 Fm"),
"15" = c("", "7 N", "15 P", "33 As", "51 Sb", "83 Bi", "115 Mc", "", "69 Tm", "101 Md"),
"16" = c("", "8 O", "16 S", "34 Se", "52 Te", "84 Po", "116 Lv", "", "70 Yb", "102 No"),
"17" = c("", "9 F", "17 Cl", "35 Br", "53 I", "85 At", "117 Ts", "", "71 Lu", "103 Lr"),
"18" = c("2 He", "10 Ne", "18 Ar", "36 Kr", "54 Xe", "86 Rn", "118 Og", "", "", "")
)
#####################################################################
## Create the table from the data ##
#####################################################################
gt_colored <- elements %>%
# create markdown instruction to make numbers and abbreviations on separate lines
mutate(
across(
.cols = everything(),
.fns = ~ str_replace_all(string = .," ","<br>")
)
) %>%
## numbers as rownames
gt(rowname_col = "rowname") %>%
## alignment in cells
cols_align(align = "center") %>%
## put numbers and abbreviations on separate lines
fmt_markdown(columns = TRUE) %>%
# Non metals reactive
tab_style(
style = cell_fill(color = "#FFD700"),
locations = list(
cells_body(
columns = "1",
rows = "1"
),
cells_body(
columns = c("14", "15", "16", "17"),
rows = "2"
),
cells_body(
columns = c("15", "16", "17"),
rows = "3"
),
cells_body(
columns = "17",
rows = "5"
),
cells_body(
columns = c("16", "17"),
rows = "4"
)
)
) %>%
# non metal noble gas
tab_style(
style = cell_fill(color = "#7FFFD4"),
locations = cells_body(
columns = "18",
rows = c(1:6)
)
) %>%
# metals alkali
tab_style(
style = cell_fill(color = "#F08080"),
locations = cells_body(
columns = "1",
rows = c(2:7)
)
) %>%
# metals alkaline earth
tab_style(
style = cell_fill(color = "#F0E68C"),
locations = cells_body(
columns = "2",
rows = c(2:7)
)
) %>%
# metals transition
tab_style(
style = cell_fill(color = "#FFB6C1"),
locations = list(
cells_body(
columns = c("4", "5", "6", "7", "8", "9", "10", "11"),
rows = c(4:6)
),
cells_body(
columns = "3",
rows = c(4:5)
),
cells_body(
columns = c("4", "5", "6", "7", "8"),
rows = 7
)
)
) %>%
# metals actinide
tab_style(
style = cell_fill(color = "#ff99cc"),
locations = list(
cells_body(
columns = c("3", " "),
rows = 7
),
cells_body(
columns = c("4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17"),
rows = 10
)
)
) %>%
# metals lanthanide
tab_style(
style = cell_fill(color = "#ffccff"),
locations = list(
cells_body(
columns = c("3", " "),
rows = 6
),
cells_body(
columns = c("4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17"),
rows = 9
)
)
) %>%
# properties not yet determined
tab_style(
style = cell_fill(color = "#D8BFD8"),
locations = cells_body(
columns = c("9", "10", "11", "12", "13", "14", "15", "16", "17", "18"),
rows = 7
)
) %>%
# metals post transition
tab_style(
style = cell_fill(color = "#B0C4DE"),
locations = list(
cells_body(
columns = "13",
rows = 3
),
cells_body(
columns = c("12", "13"),
rows = 4
),
cells_body(
columns = c("12", "13", "14"),
rows = 5
),
cells_body(
columns = c("12", "13", "14", "15", "16", "17"),
rows = 6
)
)
) %>%
# metalloids
tab_style(
style = list(
cell_fill(color = "#BDB76B")
),
locations = list(
cells_body(
columns = "13",
rows = 2
),
cells_body(
columns = "14",
rows = c(3:4)
),
cells_body(
columns = "15",
rows = c(4:5)
),
cells_body(
columns = "16",
rows = 5
)
)
)
gt_final <- gt_colored %>%
## remove borders for empty cells
tab_header(
title = "Periodic table of elements"
) %>%
tab_style(
style = list(
cell_borders(
sides = "all",
weight = NULL
)
),
locations = list(
cells_stub(rows = c(1:10)),
cells_body(
columns = c("2", "3", " ", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17"),
rows = 1
),
cells_body(
columns = c("3", " ", "4", "5", "6", "7", "8", "9", "10", "11", "12"),
rows = c(2:3)
),
cells_body(
columns = c(" "),
rows = c(4:5)
),
cells_body(
columns = c("1", "2", "3", " "),
rows = c(8:10)
),
cells_body(
columns = "18",
rows = c(8:10)
)
)
) %>%
## add borders on every side for full cells
tab_style(
style = cell_borders(),
locations = list(
cells_body(
columns = c("1", "18"),
rows = 1:7
),
cells_body(
columns = c("2", "13", "14", "15", "16", "17"),
rows = 2:7
),
cells_body(
columns = c("3", "4", "5", "6", "7", "8", "9", "10", "11", "12"),
rows = 4:7
),
cells_body(
columns = " ",
rows = 6:7
),
cells_body(
columns = c("4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17"),
rows = 9:10
)
)
) %>%
## remove borders for non-cells places by putting them in white as "style = NULL" doesn't work
tab_options(
table.border.top.color = "#FFFFFF",
table.border.bottom.color = "#FFFFFF",
table_body.border.bottom.color = "#FFFFFF",
table.border.left.color = "#FFFFFF",
table.border.right.color = "#FFFFFF",
heading.border.bottom.color = "#FFFFFF",
column_labels.border.bottom.color = "#FFFFFF"
) %>%
## add footnotes
tab_footnote(
footnote = "(a) Whether group 3 is composed of -La-Ac or -Lu-Lr is under review by the IUPAC. (b) The last two members of the group are known as transition metals.",
locations = cells_column_labels(columns = "3")
) %>%
tab_footnote(
footnote = "Some authors treat Zn, Cd and Hg as transition metals.",
locations = cells_column_labels(columns = "12")
) %>%
## change footnote symbol (can't choose specifically those used on Wikipedia)
opt_footnote_marks(marks = "standard")
gtsave(gt_final, filename = "periodic-table.png")