The PyeongChang 2018 Winter Olympics are complete and final medal counts are available.

A web site showing the medal counts

https://en.wikipedia.org/wiki/2018_Winter_Olympics_medal_table

More details are available at

https://www.olympic.org/pyeongchang-2018/results/en/general/medal-standings.htm

The web site shows a table; it might be nice to show the results graphically.

The Wikipedia page (at the time of writing) contains the standings data in a form that is easy to scrape.

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

library(rvest)
## Loading required package: xml2
URL <- "https://en.wikipedia.org/wiki/2018_Winter_Olympics_medal_table"
page <- read_html(URL)
page_tables <- html_table(page, fill = TRUE)
length(page_tables)
## [1] 5
mtable <- page_tables[[2]]

The table is unusually clean; only rank might need adjusting (or could be dropped), and the .

head(mtable)
##   Rank                 NOC Gold Silver Bronze Total
## 1    1        Norway (NOR)   14     14     11    39
## 2    2       Germany (GER)   14     10      7    31
## 3    3        Canada (CAN)   11      8     10    29
## 4    4 United States (USA)    9      8      6    23
## 5    5   Netherlands (NED)    8      6      6    20
## 6    6        Sweden (SWE)    7      6      1    14
str(mtable)
## 'data.frame':    31 obs. of  6 variables:
##  $ Rank  : chr  "1" "2" "3" "4" ...
##  $ NOC   : chr  "Norway (NOR)" "Germany (GER)" "Canada (CAN)" "United States (USA)" ...
##  $ Gold  : int  14 14 11 9 8 7 5 5 5 5 ...
##  $ Silver: int  14 10 8 8 6 6 8 6 4 3 ...
##  $ Bronze: int  11 7 10 6 6 1 4 4 6 6 ...
##  $ Total : int  39 31 29 23 20 14 17 15 15 14 ...
library(dplyr)
mtable <- mutate(mtable, Rank = as.numeric(Rank))
## Warning in evalq(as.numeric(Rank), <environment>): NAs introduced by
## coercion

It is also useful to drop the redundant Total variable and the total row (which had it’s Rank converted to NA):

mtable <- select(mtable, -Total)
mtable <- filter(mtable, ! is.na(Rank))
head(mtable)
##   Rank                 NOC Gold Silver Bronze
## 1    1        Norway (NOR)   14     14     11
## 2    2       Germany (GER)   14     10      7
## 3    3        Canada (CAN)   11      8     10
## 4    4 United States (USA)    9      8      6
## 5    5   Netherlands (NED)    8      6      6
## 6    6        Sweden (SWE)    7      6      1

A tidy form would have a variable for medal type and medal count:

library(tidyr)
mtable_tidy <- gather(mtable, medal, count, Gold : Bronze)
head(mtable_tidy)
##   Rank                 NOC medal count
## 1    1        Norway (NOR)  Gold    14
## 2    2       Germany (GER)  Gold    14
## 3    3        Canada (CAN)  Gold    11
## 4    4 United States (USA)  Gold     9
## 5    5   Netherlands (NED)  Gold     8
## 6    6        Sweden (SWE)  Gold     7

A first graph:

library(ggplot2)
ggplot(mtable_tidy) +
    geom_col(aes(x = NOC, y = count, fill = medal)) +
    coord_flip()

An easy way to match the country order on the web site:

ggplot(mutate(mtable_tidy, NOC = factor(NOC, rev(mtable$NOC)))) +
    geom_col(aes(x = NOC, y = count, fill = medal)) +
    coord_flip()

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

p <- ggplot(mutate(mtable_tidy,
                   NOC = factor(NOC, rev(mtable$NOC)),
                   medal = factor(medal, c("Bronze", "Silver", "Gold")))) +
    geom_col(aes(x = NOC, y = count, fill = medal)) +
    coord_flip()
p

Finally, we can choose more reasonable colors. The Hex code for Bronze, for example, is from http://www.99colors.net/name/bronze:

p + scale_fill_manual(values = c("Gold" = "#D4AF37",
                                 "Silver" = "#C0C0C0",
                                 "Bronze" = "#CD7F32"))

The pages on the https://www.olympic.org site can also be used to extract the information, but has to be assembled from the individual day results.

If this is done, the the code can be written to also obtain results for indivisual sports, for example from pages like

https://www.olympic.org/pyeongchang-2018/results/en/cross-country-skiing/medal-standings.htm