簡介
本文主要介紹一個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
聯系方式：
wechat: yt056410
Email: tyan@zju.edu.cn
QQ: 1051927088
GitHub: https://github.com/YTLogos
簡書: http://www.lxweimin.com/u/bd001545cf0b
博客: https://ytlogos.github.io/
個人簡介：
嚴濤
浙江大學作物遺傳育種在讀研究生（生物信息學方向）
偽碼農，R語言愛好者，愛開源
