简介

本文主要介绍一个R包ggflags，可以用于绘制国旗。安装的话从Github上利用包devtools安装。

devtools::install_github("baptiste/ggflags")

下面看个小例子来介绍一下

数据集

library(ggflags)#load package
set.seed(1111)
#create the dataset
data <- data.frame(x=rnorm(50), y=rnorm(50),
                   country=sample(c("ar", "us", "cn", "fr", "gb", "es"), 50 ,replace = TRUE),
                   stringsAsFactors=FALSE)
head(data)
    x                y       country
-0.0865801  -0.7055274  gb
1.3225244   -0.5910791  fr
0.6397020   -0.2796410  us
1.1747866   -1.3209782  cn
0.1162903   0.5851085   gb
-2.9308464  0.0198323   ar

绘图

library(ggplot2)
ggplot(data, aes(x=x, y=y, country=country, size=x))+
  geom_flag()+
  scale_country()+
  scale_size(range = c(0, 10))

国旗的图片是来自于EmojiOne数据集,有兴趣的可以去看看了解一下。
题目有奥运会奖牌，所以接下来就可视化一下索契冬奥运会各国奖牌，本次用国旗与国家联系起来。

爬取数据

library(dplyr)
library(rvest)
url <- "http://www.nbcolympics.com/medals"
medals <- read_html(url)%>%
  html_nodes("table")%>%
  .[[1]]%>%
  html_table()
knitr::kable(head(medals))

Country       Gold  Silver  Bronze  Total
Russia         13   11  9   33
United States   9   7   12  28
Norway         11   5   10  26
Canada         10   10  5   25
Netherlands 8   7   9   24
Germany         8   6   5   19

爬取完数据之后进行清洗

数据清洗

本文重要的一环是将国家与国旗联系起来，因此首先要将国家名缩写弄出来，这就要用到countrycode这个包了。

#install the package
install.packages("countrycode")

数据清洗

library(countrycode)
library(tidyr)
medals <- medals%>%
  mutate(code=countrycode(Country, "country.name", "iso2c"))%>%
  mutate(code=tolower(code))%>%
  gather(medal_color, count, Gold, Silver, Bronze)%>%
  mutate(medal_color=factor(medal_color, levels = c("Gold", "Silver", "Bronze")))%>%
  drop_na(Country, code)
knitr::kable(head(medals))

Country       Total code    medal_color count
Russia         33    ru    Gold       13
United States  28    us    Gold        9
Norway         26    no    Gold       11
Canada         25    ca    Gold       10
Netherlands    24    nl    Gold        8
Germany        19    de    Gold        8

绘图

由于国家数量太多，并且好多国家奖牌数基本为零，因此我们筛选一下：只绘制总奖牌数不小于5的国家。

medals%>%filter(Total>=5)%>%
  ggplot(aes(x=reorder(Country, Total), y=count))+
  geom_bar(stat = "identity", aes(fill=medal_color))+
  geom_flag(aes(y=-2,country=code), size=10)+
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size = 7, vjust = 0.5))+
  scale_fill_manual(values = c(
    "Gold"="gold",
    "Bronze" = "#cd7f32",
    "Silver" = "#C0C0C0"
  ))+
  scale_y_continuous(expand = c(0.1, 1))+
  xlab("Country")+
  ylab("Number of medals")+
  theme_bw()+
  theme(panel.grid = element_blank())+
  theme(legend.justification = c(1, 0), legend.position = c(1, 0))+
  theme(legend.title = element_blank())+
  coord_flip()

SessionInfo

sessionInfo()
## R version 3.4.1 (2017-06-30)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 16.04.3 LTS
## 
## Matrix products: default
## BLAS: /usr/lib/atlas-base/atlas/libblas.so.3.0
## LAPACK: /usr/lib/atlas-base/atlas/liblapack.so.3.0
## 
## locale:
##  [1] LC_CTYPE=zh_CN.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=zh_CN.UTF-8        LC_COLLATE=zh_CN.UTF-8    
##  [5] LC_MONETARY=zh_CN.UTF-8    LC_MESSAGES=zh_CN.UTF-8   
##  [7] LC_PAPER=zh_CN.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=zh_CN.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] bindrcpp_0.2     tidyr_0.7.1      countrycode_0.19 rvest_0.3.2     
## [5] xml2_1.1.1       dplyr_0.7.3      ggflags_0.0.1    ggplot2_2.2.1   
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_0.12.12     compiler_3.4.1   plyr_1.8.4       highr_0.6       
##  [5] bindr_0.1        tools_3.4.1      digest_0.6.12    evaluate_0.10.1 
##  [9] tibble_1.3.4     gtable_0.2.0     pkgconfig_2.0.1  rlang_0.1.2     
## [13] curl_2.8.1       yaml_2.1.14      stringr_1.2.0    httr_1.3.1      
## [17] knitr_1.17       tidyselect_0.2.0 rprojroot_1.2    grid_3.4.1      
## [21] glue_1.1.1       R6_2.2.2         XML_3.98-1.9     rmarkdown_1.6   
## [25] purrr_0.2.3      selectr_0.3-1    magrittr_1.5     backports_1.1.0 
## [29] scales_0.5.0     htmltools_0.3.6  assertthat_0.2.0 colorspace_1.3-2
## [33] labeling_0.3     stringi_1.1.5    lazyeval_0.2.0   munsell_0.4.3