---
title: "Olympic Medal Standings"
output:
  html_document:
    toc: yes
---

```{r global_options, include = FALSE}
knitr::opts_chunk$set(collapse = TRUE)
```

```{r, include = FALSE}
library(dplyr)
library(ggplot2)
library(lattice)
library(gridExtra)
set.seed(12345)
```

The Milan-Cortina 2026 Winter Olympics are now complete and medal counts
are a thing.

The official web site shows the [medal
counts](https://www.olympics.com/en/milano-cortina-2026/medals) as a
table. It might be nice to show the results graphically.

The official web site is challenging to scrape, but an alternative is
available:

<https://en.wikipedia.org/wiki/2026_Winter_Olympics_medal_table>
<!-- https://en.wikipedia.org/w/index.php?title=2026_Winter_Olympics_medal_table&oldid=1340005726 -->

The Wikipedia page on `r Sys.Date()` contains the standings
data in a form that is easy to scrape.

Using the `rvest` and `xml2` packages we can extract the table from the
page:

<!-- ## nolint start: line_length -->
```{r}
library(rvest)
## URL <- "https://en.wikipedia.org/wiki/2026_Winter_Olympics_medal_table"
## Use permanent link in case the page changes:
URL <- "https://en.wikipedia.org/w/index.php?title=2026_Winter_Olympics_medal_table&oldid=1340005726"
page <- read_html(URL)
page_tables <- html_table(page, fill = TRUE)
length(page_tables)
mtable <- page_tables[[3]]
```
<!-- ## nolint end -->

The table is unusually clean:

```{r}
head(mtable)
tail(mtable)
```

Only Rank might need adjusting (or could be dropped), the name of
the second column needs fixing, and the final Totals row can be dropped:

```{r}
library(dplyr)
mtable <- filter(mtable, ! grepl("^Totals", Rank)) |>
    mutate(Rank = as.numeric(Rank))
colnames(mtable)[[2]] <- "NOC"
tail(mtable)
```

For plotting it is useful to have a longer form with a variable for
`medal` type and medal `count`:

```{r}
library(tidyr)
mtable_long <- pivot_longer(mtable, Gold : Bronze,
                            names_to = "medal",
                            values_to = "count")
head(mtable_long)
```

A first graph:
```{r}
library(ggplot2)
ggplot(mtable_long) +
    geom_col(aes(y = NOC, x = count, fill = medal))
```

One way to match the country order on the web site:

```{r}
ggplot(mutate(mtable_long, NOC = factor(NOC, rev(mtable$NOC)))) +
    geom_col(aes(y = NOC, x = count, fill = medal))
```

Reordering the medal type levels makes the reason for the country
ordering easier to see:

```{r}
p <- ggplot(mutate(mtable_long,
                   NOC = factor(NOC, rev(mtable$NOC)),
                   medal = factor(medal, c("Bronze", "Silver", "Gold")))) +
    geom_col(aes(y = NOC, x = count, fill = medal))
p
```

We can choose more reasonable colors. The Hex code for
`Bronze`, for example, is from <https://www.99colors.net/name/bronze>:

```{r}
p <- p + scale_fill_manual(values = c("Gold" = "#D4AF37",
                                      "Silver" = "#C0C0C0",
                                      "Bronze" = "#CD7F32"))
p
```

Finally some theme adjustments:

```{r}
p + theme_minimal() +
    theme(legend.position = "top",
          panel.grid.major.y = element_blank()) +
    guides(fill = guide_legend(reverse = TRUE)) +
    scale_x_continuous(expand = c(0, 0)) +
    labs(y=NULL, x = "Count", fill = "Medal")
```

<!--
Fiddling with the shapes in the guide:
-->
```{r, eval = FALSE, echo = FALSE}
ggplot(mutate(mtable_long,
              NOC = factor(NOC, rev(mtable$NOC)),
              medal = factor(medal, c("Bronze", "Silver", "Gold")))) +
    geom_col(aes(y = NOC, x = count, fill = medal), key_glyph = "dotplot") +
    scale_fill_manual(values = c("Gold" = "#D4AF37",
                                 "Silver" = "#C0C0C0",
                                 "Bronze" = "#CD7F32")) +
    guides(fill = guide_legend(override.aes = list(size = 15),
                               reverse = TRUE)) +
    scale_x_continuous(expand = c(0, 0)) +
    theme_minimal() +
    theme(legend.position = "top") +
    labs(y=NULL, x = "Count", fill = "Medal")

```