【R】オリンピックメダルはどこへ？　メダリストの出身国

1. はじめに

４年に一度、アスリートの祭典であるオリンピックが盛大に開催されますが（ちなみに2020年東京五輪は延期、その後、どうなるやら。。。）、どこの国が多くのメダルを獲得しているのでしょうか？夏のオリンピックのメダル獲得数（金、銀、銅の合計）を地図上に表示してみたいと思います。

2. データ

各国のメダル獲得数は、Wkipediaの”All-time Olympic Games medal table”からとってきます。htmlにtableとしてデータが埋め込まれていますので、これを取得します。

2.1 地図データ準備

その前に、地図の表示について。mapsパッケージを用います。まず、その準備から。CoordinateCleanerパッケージに入っている、緯度・経度の情報を用います。次のように、centroidの座標位置にメダル数に応じた円を表示することにします。

library(tidyverse)
library(httr)
library(maps)

library(CoordinateCleaner)

world <- map_data("world")

countries <- as_tibble(countryref) %>%
  distinct(name, .keep_all = TRUE) %>%
  rename(nationality = name,
         long = centroid.lon,
         lat = centroid.lat) %>%
  mutate(iso3=as.character(iso3))%>%
  drop_na()

> head(countries)
# A tibble: 6 x 11
  iso3  iso2  adm1_code nationality type     long   lat capital          capital.lon capital.lat area_sqkm
  <chr> <chr> <fct>     <chr>       <fct>   <dbl> <dbl> <fct>                  <dbl>       <dbl>     <dbl>
1 ABW   AW    ABW       Aruba       country -70.0  12.5 Oranjestad            -70.0        12.5      170. 
2 AFG   AF    AFG       Afghanistan country  65.2  33.7 Kabul                  69.2        34.5   642182. 
3 AGO   AO    AGO       Angola      country  18.5 -12.5 Luanda                 13.2        -8.83 1244654. 
4 AIA   AI    AIA       Anguilla    country -63.0  18.2 The Valley            -63.0        18.2       80.7
5 ALB   AL    ALB       Albania     country  20    41   Tirana                 19.8        41.3    28336. 
6 AND   AD    AND       Andorra     country   1.5  42.5 Andorra la Vella        1.52       42.5      452. 

2.2 Wikipediaからデータのスクレイピング

Wikipediaよりデータをとってきます。国名のデータをうまく整形できなかったので、別ファイルにして読み込んでいます。。。

library(rvest)
response <- GET("https://en.wikipedia.org/wiki/All-time_Olympic_Games_medal_table")
rawResponse <- content(response, "raw")

tableNodes <- read_html(rawResponse[rawResponse != 0]) %>% html_nodes("table")
tables <- html_table(tableNodes[1:9], fill=TRUE)

c_name <- read.csv("https://www.dinov.tokyo/Data/Upload/country_name.csv", header = FALSE)

2.3 データの整形

地図の緯度・経度の情報と、メダル数を、国をkeyとしてjoinします。

dat <- as.data.frame(lapply(tables[[2]], 
                         function(x) { gsub("\u00A0", "", x)})) %>% 
  slice(-1, -n()) %>%
  select(country = colnames(.)[1], medal = Summer.Games.4) %>%
  slice(-c(150:152)) %>%
  cbind(c_name) %>%
  select(iso3 = V2, country = V1, medal) %>%
  mutate(medal = as.numeric(gsub(",", "", medal))) %>%
  left_join(countries, by="iso3") 
  

> head(dat)
  iso3       country medal iso2 adm1_code nationality    type    long     lat      capital capital.lon capital.lat
1  AFG  Afghanistan      2   AF       AFG Afghanistan country  65.216  33.677        Kabul       69.18       34.52
2  ALG      Algeria     17 <NA>      <NA>        <NA>    <NA>      NA      NA         <NA>          NA          NA
3  ARG    Argentina     74   AR       ARG   Argentina country -65.167 -35.377 Buenos Aires      -58.67      -34.58
4  ARM      Armenia     14   AM       ARM     Armenia country  45.000  40.000      Yerevan       44.50       40.17
5  ANZ  Australasia     12 <NA>      <NA>        <NA>    <NA>      NA      NA         <NA>          NA          NA
6  AUS    Australia    497   AU       AUS   Australia country 133.000 -27.000     Canberra      149.13      -35.27
   area_sqkm
1  642181.62
2         NA
3 2784305.92
4   29588.31
5         NA
6 7691175.09

実は、ここまで来るのに、非常に時間を費やしてしまいました。。。

3. プロット

プロットしてみます。

ggplot() +
  geom_polygon(data = world, aes(x = long, y = lat, group = group), 
               fill = "gray", alpha = .3) +
  geom_jitter(data=dat, aes(x=long, y=lat, size = medal), 
              alpha = .7, shape=21, color = "black",
              position = position_jitter(width = 3, height = 3, seed = 1234)) +
  labs(title = "Where on Earth do Olympic medals Come From?",
       caption = "Source: Wikipedia 'All-time Olympic Games medal table' ",
       x = NULL,
       y = NULL,
       fill = NULL) +
  theme(legend.position = "bottom",
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  guides(size = FALSE) +
  coord_quickmap()

こんな感じでUSAが圧倒的に多いですね。もう少しキレイなプロットにしたかったのですが、今日はここまで。