R语言可视化：练习（地图、柱形图）REmap

REmap,更多地图可视化细节查看ECharts 。ECharts是一个JavaScript库，主要是用于数据可视化。地图功能是其中的一部分，有其他人二次开发的R包。

  1. 使用的包ggplot2,REmap,dplyr,RColorBrewer,tidyr
  2. 涉及到知识点：函数传参，长短数据互转（tidyr包），颜色向量（RColorBrewer包），地图可视化（REmap）
rm(list = ls())
###################
##目的：生成2019年各阶段学生的性别比例分布地图数据。
######################
##ggmap需要注册，而且需要绑定信用卡，收费了
##REmap和leafletCN是同一个人写的R包，REmap是Easycharts
#install.packages("ggmap")
#library(ggmap)
library(ggplot2)
#get_map("CHINA")
setwd("E:/cm/R/")

###读取各级学校学生分布情况表
primary <- read.csv("PrimarySchool.csv",encoding = "UTF-8")
head(primary)
middle <- read.csv("MiddleSchool.csv",encoding = "UTF-8")
senior <- read.csv("SeniorSchool.csv",encoding = "UTF-8")
higher <- read.csv("NormalAndShort-cycleHigherEducation.csv",encoding = "UTF-8")
postgraduate <- read.csv("PostGraduate.csv",encoding = "UTF-8")

##baidu地图开发的地图包REmap
#install.packages("devtools")#如果安装了就不需要这步
library(devtools)
#install_github('lchiffon/REmap')
library(REmap)
##引入RcolorBrewer调色板，方便调色
#install.packages("RColorBrewer")
library(RColorBrewer)
display.brewer.all()
library(dplyr)

#install_github("tomwenseleers/export",build_vignettes = FALSE)
library(export)
out_img <- function(name,width=7,height=5){
  graph2svg(file=paste(name,".svg",sep = ""), width=width, height=height)
  graph2png(file=paste(name,".png",sep = ""),width=width,height=height)
}
##自定义函数，用于生成该级别学生的性别比例
##其中设置totalC的默认参数为在校总人数（Enrolment.Total）
getMap <- function(school,Female,schoolTitle,colour,totalC= "Enrolment.Total"){
  ##赋值给color作为颜色向量
  color <- brewer.pal(n= 8,name = colour)
  ##反转颜色向量，让深色对应大数值
  color <- rev(color)
  province <- school[,1][2:32]
  value <- ((school[,totalC]/school[,Female]-1)*100)[2:32]
  PrimaryPopulation <- data.frame(province,value)
  #print(PrimaryPopulation)
  titlename <- paste(schoolTitle,"男女性别比例图（女生为100）",sep = "")
  primaryS <- remapC(PrimaryPopulation,maptype = 'china',color= color,title = titlename,theme=get_theme('Blue'),markLineTheme = )
  primaryS
}

#############################此处生成的地图在浏览器中打开，生成的是可交互的html页面
##获取在校生的数据
#注意：参数一定要带上引号，不然不能正常运行函数
getMap(primary,'Female',"小学","YlOrRd")
getMap(middle,'Female',"初中","YlGnBu")
getMap(senior,'Female',"高中","YlGn")
getMap(higher,'Enrolment.Female',"大学本科和专科","PuRd")
getMap(postgraduate,'Enrolment.Female',"研究生","BuPu")

#获取毕业生的数据
getMap(higher,'Graduates.Female',"大学本科和专科毕业生","YlOrBr",'Graduates.Total')
getMap(postgraduate,'Graduates.Female',"研究生毕业生","RdPu",'Graduates.Total')


##########################################
#生成单独的每个阶段的柱形图
##########################################
getBar <- function(school,Female,schoolTitle,totalC= "Enrolment.Total"){
  province <- school[,1][2:32]
  value <- ((school[,totalC]/school[,Female]-1)*100)[2:32]
  z <- seq(1:31)
  PrimaryPopulation <- data.frame(province,value,z)
  PrimaryPopulation <- PrimaryPopulation[order(PrimaryPopulation$value),]
  #生成柱状图
  label <- paste(schoolTitle,"男女性别比例图（女生为100）",sep="")
  ggplot(data = PrimaryPopulation,mapping=aes(x = reorder(province,value),y = value))+geom_bar(stat='identity',fill=value)+ggtitle(label = label)+xlab("省份")+ylab("人数")+
    theme(plot.title = element_text(hjust = 0.5))+geom_hline(aes(yintercept=100),color="red")+
    scale_y_continuous(expand=c(0,0))
  #print(value)
}

# install.packages("patchwork")
# library(patchwork)
getBar(primary,'Female',"小学")
#####存在问题是：使用export输出图片时候，只有ppt格式中文能正常显示。其他格式下中文乱码。
#out_img(name="各省小学")
#graph2ppt(file="各省小学生")
ggsave("各省小学生.png",width=10,height=5)

getBar(middle,'Female',"初中")
ggsave("各省初中.png",width = 10,height = 5)

getBar(senior,'Female',"高中")
ggsave("各省高中.png",width = 10,height = 5)

getBar(higher,'Enrolment.Female',"大学本科和专科在校生")
ggsave("各省大学和大专.png",width = 10,height = 5)

getBar(postgraduate,'Enrolment.Female',"研究生在校生")
ggsave("各省研究生.png",width = 10,height = 5)
getBar(higher,'Graduates.Female','大学和大专毕业生','Graduates.Total')
ggsave("各省大学和大专毕业生.png",width = 10,height = 5)
getBar(postgraduate,'Graduates.Female','研究生毕业生','Graduates.Total')
ggsave("各省研究生毕业生.png",width = 10,height = 5)
##########################################
#合并到一起生成柱形图
#将各个阶段都放在一起，生成分组柱形图
##########################################
library(tidyr)
getvalue <- function(school,Female,totalC= "Enrolment.Total"){
  value <- ((school[,totalC]/school[,Female]-1)*100)[2:32]
  return(value)
}

priValue <- getvalue(primary,'Female')
midValue <- getvalue(middle,'Female')
senValue <- getvalue(senior,'Female')
higValue <- getvalue(higher,'Enrolment.Female')
posValue <- getvalue(postgraduate,'Enrolment.Female')

allinfo <- data.frame(primary[,1][2:32],priValue,midValue,senValue,higValue,posValue)
colnames(allinfo) <- c("province","primary","middle","senior","higher","postgraduate")
##使用tidyr包的gather函数，将宽数据变成长数据，%>%相当于shell的管道符|
##gather()将除了province列的其他列合并成两列，1列是学校，1列是值
allinfoNew <- allinfo %>% gather(school,value, -province)

##生成从1到数据框的列表的长度的自然数向量，用于画图时，作为参考列进行排序，reorder(school,z)，即为依照z的顺序对school进行排序。
z <- seq(1:length(allinfoNew$province))
##生成柱形堆积图
ggplot(data = allinfoNew,mapping=aes(x = reorder(province,z),y = value,fill=reorder(school,z)))+geom_bar(stat = 'identity')+
  xlab("省份")+ylab("男生人数（女生为100）")+
  ggtitle(label = "2019年全国学生男女性别比例分布图")+
  labs(fill="学生阶段")+ scale_fill_discrete(labels=c("小学", "初中", "高中","大学和大专","研究生"))+
  theme(plot.title = element_text(hjust = 0.5))+
  scale_y_continuous(expand=c(0,0))
ggsave("全国学生堆积图.png",width = 11,height = 7)
#labs(fill="学生阶段")设置图例的标题 
#scale_fill_discrete(labels=c("小学", "初中", "高中","大学和大专","研究生"))设置图例的分类的名称
#geom_hline(aes(yintercept=100),color="red")生成一条红色的横线作为阈值线
#xlab("省份")修改x轴标题
#ylab(“男生人数”)修改y轴标题
#scale_y_continuous(expand=c(0,0)) 让y坐标轴0刻度下面没有空白
#coord_flip()翻转坐标轴的x和y轴

##生成分组柱形图
ggplot(data = allinfoNew)+geom_bar(mapping = aes(x=reorder(province,rev(z)),y = value,fill = reorder(school,z)),position="dodge",stat="identity")+
  geom_hline(aes(yintercept=100),color="red")+xlab("省份")+ylab("男生人数（女生为100）")+ggtitle(label = "2019年全国学生男女性别比例分布图")+
  labs(fill="学生阶段")+ scale_fill_discrete(labels=c("小学", "初中", "高中","大学和大专","研究生"))+
  theme(plot.title = element_text(hjust = 0.5))+
  scale_y_continuous(expand=c(0,0)) 
ggsave("全国学生分组柱形图.png",width = 12,height = 7)  

ggplot(data = allinfoNew)+geom_bar(mapping = aes(x=reorder(province,z),y = value,fill = reorder(school,z)),position="dodge",stat="identity")+
  geom_hline(aes(yintercept=100),color="red")+xlab("省份")+ylab("男生人数（女生为100）")+ggtitle(label = "2019年全国学生男女性别比例分布图")+
  labs(fill="学生阶段")+ scale_fill_discrete(labels=c("小学", "初中", "高中","大学和大专","研究生"))+
  theme(plot.title = element_text(hjust = 0.5))+
  scale_y_continuous(expand=c(0,0))+coord_flip() 
ggsave("全国学生分组柱形图-水平方向.png",width = 5,height = 8)  

##leafletCN是leaflet的中国扩展包
# devtools::install_github("lchiffon/leafletCN")
# library(leafletCN)
# demomap("河南")
# demomap("china")
#
回到页面顶部