├── README.md
└── tbl_bigmac.rmd


/README.md:
--------------------------------------------------------------------------------
 1 | # RStudio Table Contest 2020 Submission
 2 | 
 3 | ## [The Big Mac Index Table](https://rpubs.com/acalatroni/682678)
 4 | 
 5 | Our goal for the [2020 RStudio Table Contest](https://blog.rstudio.com/2020/09/15/announcing-the-2020-rstudio-table-contest/) was to learn and practice with the [gt package](https://gt.rstudio.com/). To do so we decided to focus on the following aspects: 
 6 | -	Include interactive figures within the table. For this, we chose the [echarts4r package](https://echarts4r.john-coene.com/) to create interactive graphics with Echarts Javascripts, albeit other packages would have also worked (ie. Plotly, highcharter, etc.)
 7 | -	Include images, either through a [GitHub](https://github.com/HatScripts/circle-flags) repo (flags) or Wikimedia commons scraping (maps). 
 8 | -	Include as many HTML tricks as necessary to improve the overall readability of the table (for example HTML color of headers, icons, spanners, hyperlinks, currency symbols,  scale up the image size (maps) on hover, etc.)
 9 | -	Include footnotes, in particular a footnote color legend for the color column, an HTML details tab to display in an inconspicuous way the R session information, and font awesome icons for github and twitter hyperlinks).  
10 | - Include CSS with the [new feature](https://github.com/rstudio/gt/releases/tag/v0.2.2) `opt_css` to improve the tables aesthetics, especially in light of the interactive graphics tweaking.
11 | 
12 | In short the Big Mac Index is published by [The Economist]( https://www.economist.com/) as an informal way of measuring the purchasing power parity (PPP) between two currencies and provides a test of the extent to which market exchange rates result in goods costing the same in different countries. It seeks to make exchange-rate theory a bit more digestible. The magazine's latest version (July 2020) of the [The Big Mac index interactive currency comparison tool](https://www.economist.com/news/2020/07/15/the-big-mac-index). Furthermore, you can also download the data or read the methodology behind the Big Mac index [here]( https://github.com/TheEconomist/big-mac-data)
13 | 


--------------------------------------------------------------------------------
/tbl_bigmac.rmd:
--------------------------------------------------------------------------------
  1 | ---
  2 | title:   "<h4> <a href='https://blog.rstudio.com/2020/09/15/announcing-the-2020-rstudio-table-contest/'> 2020 RStudio Table Contest Submission </a> by A. Calatroni, S. Lussier & R. Krouse <a href='https://github.com/agstn/RStudio_table_contest_2020'> <i class='fa fa-github'></i> Repo </a>"
  3 | output:
  4 |   html_document:
  5 |     self_containded: TRUE
  6 |     code_download: yes
  7 |     code_folding: none # none hide show
  8 |     toc: false
  9 | ---
 10 | 
 11 | ```{r setup, include=FALSE}
 12 | knitr::opts_chunk$set(warning = FALSE, message = FALSE, comment = NA, include = FALSE)
 13 | knitr::opts_chunk$set(cache = FALSE)
 14 | ```
 15 | 
 16 | ```{r}
 17 | library(tidyverse)
 18 | library(rio)
 19 | library(lubridate)
 20 | # devtools::install_github("rstudio/gt")
 21 | library(gt)
 22 | library(countrycode)
 23 | library(echarts4r)
 24 | library(htmltools)
 25 | library(rvest)
 26 | library(httr)
 27 | ```
 28 | 
 29 | ```{r}
 30 | bm_1 <- import("https://raw.githubusercontent.com/TheEconomist/big-mac-data/master/output-data/big-mac-full-index.csv") %>%
 31 |    select(-starts_with(c("GBP","JPY","CNY"))) %>% 
 32 |    mutate(iso_a2    = countrycode(iso_a3 , origin = 'iso3c', destination = 'iso2c', warn = FALSE),
 33 |           iso_a2    = str_to_lower(iso_a2),
 34 |           iso_a2    = ifelse(is.na(iso_a2), "european_union", iso_a2),
 35 |           iso_fl    = str_glue("https://raw.githubusercontent.com/HatScripts/circle-flags/master/flags/{iso_a2}.svg")) %>% 
 36 |    group_by(iso_a3, iso_a2, name, currency_code, iso_fl) %>% 
 37 |    nest_by()
 38 | 
 39 | x_currencies       <- import("https://raw.githubusercontent.com/rstudio/gt/master/data-raw/x_currencies.csv") %>% 
 40 |    rename(currency_code = curr_code ) %>% 
 41 |    mutate(curr_name = word(curr_name,-1) %>% str_to_title())
 42 | 
 43 | bm_1 <- left_join(bm_1,
 44 |                   x_currencies,
 45 |                   by = "currency_code")
 46 | ```
 47 | 
 48 | ```{r}
 49 | # G20 Group of countries
 50 | # 2020: Argentina, Australia, Brazil, Canada, China, France, Germany, Italy, India, Indonesia,Japan, Republic of Korea, 
 51 | #       Mexico, Russia, Saudi Arabia, South Africa, Turkey, United Kingdom, United States European Union
 52 | # + Switzerland
 53 | 
 54 | bm_g20 <- bm_1 %>% 
 55 |    filter(iso_a3 %in% c("ARG","AUS","BRA","CAN","CHN","EUZ","IND","IDN","JPN","KOR","MEX","RUS","SAU","ZAF","TUR","USA",
 56 |                         "CHE")) %>%
 57 |    mutate( name_map = name,
 58 |            name_map = case_when(name_map == "Euro area" ~ "Europe-EU",
 59 |                                 name_map == "Russia"    ~ "Russian Federation",
 60 |                                 name_map == "China"     ~ "People's_Republic_of_China",
 61 |                                 TRUE ~ as.character(name_map)
 62 |            )) %>% 
 63 |    mutate(last = list( data %>% slice(n())) ) %>%
 64 |    mutate( map = list(
 65 |       glue::glue("https://commons.wikimedia.org/wiki/File:{str_replace_all(name_map,' ', '_')}_(orthographic_projection).svg") %>%
 66 |          read_html() %>%
 67 |          html_nodes("img") %>%
 68 |          html_attr("src") %>%
 69 |          as.data.frame() %>%
 70 |          transform(`.` = as.character(`.`)) %>%
 71 |          filter(grepl("orthographic", ., perl=TRUE)) %>%
 72 |          slice(1) %>%
 73 |          pull()
 74 |    )
 75 |    ) %>%
 76 |    unnest(last) %>% 
 77 |    ungroup() %>% 
 78 |    arrange(desc(USD_raw)) 
 79 | ```
 80 | 
 81 | ```{r}
 82 | chart <- function(data = data, variable = variable, name = name,
 83 |                   start = start, end = end,
 84 |                   width = width, height = height){
 85 |    
 86 |    d <- data %>% 
 87 |       select(date, var = variable) %>% 
 88 |       mutate(date = as.Date(date)) %>% 
 89 |       drop_na(var)
 90 |    
 91 |    m <- mean(d %>% pull(var))
 92 |    
 93 |    e <- d %>% 
 94 |       e_charts(x = date,
 95 |                width = width,
 96 |                height = height
 97 |       ) %>% 
 98 |       e_bar(var,
 99 |             name = name,
100 |             barWidth = "75%") %>%
101 |       e_legend(show = FALSE) %>%
102 |       e_y_axis(show = FALSE,
103 |                max  = 1.0,
104 |                min = -1.0) %>%
105 |       e_x_axis(show = FALSE,
106 |                min = start,
107 |                max = end) %>%
108 |       e_axis_pointer(label = list(show = FALSE)) %>% 
109 |       e_visual_map(
110 |          type = "piecewise",
111 |          pieces = list(list(gt = 0,
112 |                             color = "#0571B0"),
113 |                        list(lte = 0,
114 |                             color = "#CA0020")
115 |          ),
116 |          show = FALSE,
117 |       ) 
118 |    
119 |    if ( abs(m)>0 && nrow(d)>0 ) {
120 |       e <- e %>% 
121 |          e_mark_line(data = list(yAxis = 0),
122 |                      title = '',
123 |                      silent = TRUE,
124 |                      symbol = 'none',
125 |                      animation = FALSE,
126 |                      label = list(show = TRUE,
127 |                                   postion = 'end',
128 |                                   distance = 0),
129 |                      lineStyle = list(color = '#bfbfbf',
130 |                                       type = 'solid')
131 |          ) %>%
132 |          e_mark_area(data = list(
133 |             list(xAxis = '2011-06-01', yAxis = -1.0),
134 |             list(xAxis = '2020-08-01', yAxis =  1.0)),
135 |             itemStyle = list(color = '#f2f2f2')) %>%
136 |          e_tooltip( trigger = "axis",
137 |                     axisPointer = list(type = 'shadow'),
138 |                     confine = TRUE,
139 |                     formatter = e_tooltip_pointer_formatter("percent", digits = 1),
140 |                     textStyle = list(fontSize = 10),
141 |                     padding = 2)
142 |    }
143 |    e
144 | }
145 | ```
146 | 
147 | ```{r}
148 | bm_g20 <- bm_g20 %>% 
149 |    rowwise() %>% 
150 |    mutate(eraw = list(chart(data,
151 |                             variable = "USD_raw", name = "Raw", 
152 |                             start = '2000-03-01',
153 |                             end   = '2020-08-01',
154 |                             width = 150, height = 50)),
155 |           eadj = list(chart(data,
156 |                             variable = "USD_adjusted", name = "Adj", 
157 |                             start = '2011-06-01',
158 |                             end   = '2020-08-01',
159 |                             width = 75, height = 50))
160 |    ) %>% 
161 |    mutate(eraw_html = list( eraw %>%
162 |                                as.tags() %>%
163 |                                as.character() %>%
164 |                                htmltools::HTML() ),
165 |           eadj_html = list( eadj %>%
166 |                                as.tags() %>%
167 |                                as.character() %>%
168 |                                htmltools::HTML() )
169 |    )
170 | ```
171 | 
172 | 
173 | ```{r}
174 | detach("package:rvest", unload = TRUE)
175 | detach("package:httr",  unload = TRUE)
176 | ```
177 | 
178 | ```{r}
179 | chart(data = bm_g20 %>% filter(iso_a3 == "ARG") %>% select(data) %>% unnest(),
180 |       variable = "USD_raw", name = "Raw", 
181 |       start = '2000-01-01',
182 |       end   = '2021-01-01',
183 |       width = 150, height = 50)
184 | ```
185 | 
186 | ```{r include = TRUE, echo = FALSE}
187 | tab_0 <- bm_g20 %>%
188 |    select(iso_fl, map, name, iso_a3,
189 |           currency_code, curr_name, symbol,
190 |           date, local_price, dollar_price, 
191 |           USD_raw, USD_adjusted, eraw_html, eadj_html) %>%
192 |    gt() %>% 
193 |    # add country hyperlink
194 |    text_transform(
195 |       locations = cells_body(
196 |          columns = vars(name)
197 |       ),
198 |       fn = function(x) {
199 |          glue::glue("<a href='https://en.wikipedia.org/wiki/{str_replace_all(x,' ', '_')}'>{x}</a>")
200 |       }
201 |    ) %>%
202 |    # add flags
203 |    text_transform(
204 |       locations = cells_body(
205 |          columns = vars(iso_fl)
206 |       ),
207 |       fn = function(x) {web_image(url = x, height = 30)}
208 |    ) %>% 
209 |    # add maps
210 |    text_transform(
211 |       locations = cells_body(
212 |          columns = vars(map)
213 |       ),
214 |       fn = function(x) {web_image(url = x, height = 50)}
215 |    ) %>% 
216 |    # merge currency name & code
217 |    cols_merge(columns = vars(curr_name, currency_code),
218 |               pattern = html("{1} (<small>{2}</small>)") ) 
219 | 
220 | # merge currencies to local price
221 | for (i in seq(nrow(bm_g20))) {
222 |    tab_0 <- tab_0 %>% 
223 |       fmt_currency(columns = vars(local_price), 
224 |                    rows = i, 
225 |                    currency  = bm_g20[[i, "currency_code"]])
226 | }
227 | 
228 | tab_1 <- tab_0 %>% 
229 |    # remove unused variables
230 |    cols_hide(columns = vars(iso_a3, symbol, date)) %>% 
231 |    # rename variables
232 |    cols_label( iso_fl = ' ',
233 |                map    = ' ',
234 |                name   = 'Country',
235 |                curr_name = html('Currency <small>(Abbr)</small>'),
236 |                date = html('Date <small>(yy-mm)</small>'),
237 |                eraw_html = html("<small>2000 &#8594; <font style='color: #bfbfbf'> 2011 &#8594; 2020</small></font> <br> Raw"), 
238 |                eadj_html = html("<small><font style='color: #bfbfbf'>2011 &#8594; 2020</small></font> <br> Adjusted")
239 |    ) %>% 
240 |    # align data
241 |    cols_align(align = "center", 
242 |               columns = vars(map, local_price, dollar_price, USD_raw, USD_adjusted)) %>%
243 |    cols_align(align = "left",
244 |               columns = vars(name, curr_name)) %>% 
245 |    # align columns labels
246 |    tab_style(
247 |       style = list(
248 |          cell_text(align = "left")
249 |       ),
250 |       locations = cells_column_labels(
251 |          columns = vars(name, curr_name)
252 |       )
253 |    ) %>% 
254 |    # make map square cell
255 |    cols_width(
256 |       vars(map) ~ px(60)
257 |    ) %>% 
258 |    # format missing
259 |    fmt_missing( columns = vars(USD_adjusted),
260 |                 missing_text = html("&mdash;")
261 |    ) %>% 
262 |    # format percent
263 |    fmt_percent(columns = vars(USD_raw, USD_adjusted),
264 |                decimals = 1) %>% 
265 |    # round dollar price
266 |    fmt_number(columns = vars(dollar_price),
267 |               decimals  = 2) %>% 
268 |    # add dollar sign
269 |    fmt_currency(columns = vars(dollar_price),
270 |                 currency = "USD") %>% 
271 |    # spanner
272 |    tab_spanner(
273 |       label = html("&#127991;&#65039; Latest Price"),
274 |       columns = vars(local_price, dollar_price)
275 |    ) %>% 
276 |    # spanner
277 |    tab_spanner(
278 |       label = html("&#128181; USD <small><font style='color: #CA0020'>under</font>/<font style='color: #0571B0'>over</font></small>"),
279 |       columns = vars(USD_raw, USD_adjusted)
280 |    ) %>% 
281 |    # Spanner
282 |    tab_spanner(
283 |       label = html("&#9201;&#65039; Historical Data"),
284 |       columns = vars(eraw_html, eadj_html)
285 |    ) %>% 
286 |    # labels
287 |    cols_label(local_price = "Local",
288 |               dollar_price = "Dollar" ) %>% 
289 |    cols_label(USD_raw = "Raw",
290 |               USD_adjusted = "Adjusted" ) %>% 
291 |    # Add color USD Raw & Udjusted
292 |    data_color(
293 |       columns = vars(USD_raw, USD_adjusted),
294 |       colors = scales::col_bin(
295 |          bins = c(-Inf, 0, Inf),
296 |          palette = c("#CA0020","#0571B0")
297 |       ),
298 |       apply_to = "text"
299 |    ) %>% 
300 |    # Add color to dollar price RColorBrewer::brewer.pal(11,"RdYlBu")[1:10]
301 |    data_color(
302 |       columns = vars(dollar_price),
303 |       colors = scales::col_bin(
304 |          palette = c("#A50026","#D73027","#F46D43","#FDAE61","#FEE090",
305 |                      "#FFFFBF",
306 |                      "#E0F3F8","#ABD9E9","#74ADD1", "#4575B4"),
307 |          domain = c(0,1,2,3,4,5,6,7,8,9,10),
308 |          bins = 10),
309 |       alpha = 0.5
310 |    )%>%
311 |    # make cells bold
312 |    tab_style(
313 |       style = list(
314 |          cell_text(weight = "bold")
315 |       ),
316 |       locations = cells_body(
317 |          columns = vars(USD_raw, USD_adjusted)
318 |       )
319 |    ) %>% 
320 |    # make US the baseline
321 |    tab_style(
322 |       style = cell_fill(color = "#FFFFBF", alpha = 0.5),
323 |       locations = cells_body(
324 |          rows = name  == "United States"
325 |       )
326 |    ) %>%
327 |    # add a title
328 |    tab_header(
329 |       title    = md("**Burgernomics:** The Big Mac &#127828; Index for [G20](https://en.wikipedia.org/wiki/G20) compared to the US Dollar"),
330 |       subtitle = md("Measuring the purchasing power parity (PPP) between two currencies")
331 |    ) %>% 
332 |    # add source
333 |    tab_source_note(
334 |       html('<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css"> 
335 |            <b>Source:</b>
336 |            <a href="https://www.economist.com/news/2020/07/15/the-big-mac-index"> 
337 |            The Economist: The Big Mac Index </a> introduced in  1986 as a semi-humorous illustration of PPP and has been published since then.
338 |            <br>
339 |            <a href="https://twitter.com/search?q=The%20Economist%27s%20Big%20Mac%20index%20&src=typed_query"> <i class="fa fa-twitter"style="font-size:24px"></i> The Economist Big Mac index  </a>
340 |            <br>
341 |            <a href="https://github.com/TheEconomist/big-mac-data"> <i class="fa fa-github" style="font-size:24px"></i> Data and methodology </a>
342 |            ')
343 |       
344 |    ) %>% 
345 |    tab_source_note( md( { details::details(devtools::session_info(),
346 |                                            summary = 'R Session Information'
347 |    ) 
348 |    }
349 |    )
350 |    ) %>% 
351 |    # footnotes
352 |    tab_footnote(
353 |       footnote = "Data as of 2020-07-01",
354 |       locations = cells_column_spanners(html("&#127991;&#65039; Latest Price"))
355 |    ) %>% 
356 |    tab_footnote(
357 |       footnote = 
358 |          "The index is based on the theory of PPP, the notion that in the long run exchange rates should move towards the rate
359 |       that would equalise the prices of an identical basket of goods and services (in this case, a burger) in any two countries.",
360 |       locations = cells_title("subtitle")
361 |    ) %>% 
362 |    tab_footnote(
363 |       footnote = "Raw Index: % cost difference than in the US",
364 |       locations = cells_column_labels(vars(USD_raw,eraw_html))
365 |    ) %>% 
366 |    tab_footnote(
367 |       footnote = "GDP Adjusted Index: % cost difference than in the US based on differences in GDP between the two countries",
368 |       locations = cells_column_labels(vars(USD_adjusted,eadj_html))
369 |    ) %>% 
370 |    tab_footnote(
371 |       footnote = "Base Currency",
372 |       locations = list( cells_title("title"),
373 |                         cells_body( columns = vars(local_price, dollar_price),
374 |                                     rows = name  == "United States")
375 |       )
376 |    ) %>% 
377 |    tab_footnote(
378 |       footnote = md('ABBR: Three-character [ISO 4217 currency code](https://www.iso.org/iso-4217-currency-codes.html)'),
379 |       locations = cells_column_labels(vars(curr_name))
380 |    ) %>%
381 |    tab_footnote(
382 |       footnote = html('Price of a Big Mac in the local currency'),
383 |       locations = cells_column_labels(vars(local_price))
384 |    ) %>% 
385 |    tab_footnote(
386 |       footnote = html('Price of a Big Mac in dollars <br>
387 |                        <span style="background-color: #A50026; opacity: 0.5;"> &emsp;&emsp;&nbsp;</span>
388 |                        <span style="background-color: #D73027; opacity: 0.5;"> &emsp;&emsp;</span>
389 |                        <span style="background-color: #F46D43; opacity: 0.5;"> &emsp;&emsp;</span>
390 |                        <span style="background-color: #FDAE61; opacity: 0.5;"> &emsp;&emsp;</span>
391 |                        <span style="background-color: #FEE090; opacity: 0.5;"> &emsp;&emsp;</span>
392 |                        <span style="background-color: #FFFFBF; opacity: 0.5;"> &emsp;&emsp;</span>
393 |                        <span style="background-color: #E0F3F8; opacity: 0.5;"> &emsp;&emsp;</span>
394 |                        <span style="background-color: #ABD9E9; opacity: 0.5;"> &emsp;&emsp;</span>
395 |                        <span style="background-color: #74ADD1; opacity: 0.5;"> &emsp;&emsp;</span>
396 |                        <span style="background-color: #4575B4; opacity: 0.5;"> &emsp;&emsp;&nbsp;&nbsp;</span>
397 |                        <br>
398 |                        <span style="color: black;">      $0-1&nbsp;</span>
399 |                        <span style="color: black;"> &nbsp;1-2&nbsp;</span>
400 |                        <span style="color: black;"> &nbsp;2-3&nbsp;</span>
401 |                        <span style="color: black;"> &nbsp;3-4&nbsp;</span>
402 |                        <span style="color: black;"> &nbsp;4-5&nbsp;</span>
403 |                        <span style="color: black;"> &nbsp;5-6&nbsp;</span>
404 |                        <span style="color: black;"> &nbsp;6-7&nbsp;</span>
405 |                        <span style="color: black;"> &nbsp;7-8&nbsp;</span>
406 |                        <span style="color: black;"> &nbsp;8-9&nbsp;</span>
407 |                        <span style="color: black;"> &nbsp;9-10&nbsp;</span>
408 |                          '),
409 |       locations = cells_column_labels(vars(dollar_price))
410 |    ) %>% 
411 |    # transparent trick: do not print 0%
412 |    tab_style(
413 |       style = cell_text(color = 'transparent'),
414 |       locations = cells_body(
415 |          columns = vars(USD_raw, USD_adjusted),
416 |          rows = name  == "United States")
417 |    ) %>%
418 |    # add options left align
419 |    opt_align_table_header( align = "left") %>% 
420 |    # upper
421 |    opt_all_caps(locations = "column_labels") %>% 
422 |    # theme compact
423 |    tab_options(table.font.size      = px(14),
424 |                data_row.padding     = px(1),
425 |                footnotes.padding    = px(1),
426 |                source_notes.padding = px(1),
427 |                row_group.padding    = px(1)) %>% 
428 |    # add CSS
429 |    opt_css(css = ".html-widget {margin-bottom: 0px;}") %>% 
430 |    opt_css(css = ".gt_row:nth-child( 9){overflow-y: hidden;}") %>% 
431 |    opt_css(css = ".gt_row:nth-child(10){overflow-y: hidden;}") %>%
432 |    opt_css(css = ".gt_row:nth-child( 2):hover{transform: scale(2);}") %>% 
433 |    # change font
434 |    opt_table_font(
435 |       font = list(google_font(name = "Source Sans Pro"))
436 |    ) 
437 | 
438 | tab_1
439 | ```
440 | 


--------------------------------------------------------------------------------