这样的地图才漂亮，一起学习一下-经管之家官网！

免费学术公开课,扫码加入

相关数据和更多代码请关注我们公众号索取，下面有二维码

相关数据和代码链接：http://pan.baidu.com/s/1c0AnhW8密码：微信索取

今天学习一下R做地图和综合排名，数据我们选择2014年《中国卫生和计划生育统计年鉴》的数据作为数据源，比较官方，首先我们需要调用一些包。

1. library(maps)
   
2. library(ggplot2)
   
3. library(maptools)
   
4. library(directlabels)
   
5. library(mapproj)
   
6. library(plyr)
   
7. library(reshape2)
   
8. library(ggsubplot)

以上是我们要调用的包，下面我们读入地图数据，地图数据主要包括三个文件，bou2_4p.dbf、bou2_4p.shp、bou2_4p.shx；虽然我们只需要读取bou2_4p.shp，但必须要把他们放在同一个目录下读取时才不会报错。

1. setwd("H:")
   
2. mymap <-readShapePoly("/healthmap/bou2_4p.shp")#读取地图
   
3. mymapd <- fortify(mymap)#打散地图为数据框，方便ggplot读取
   
4. ## Regions defined for each Polygons
   
5. temp<-mymap@data#提取地图省份
   
6. xs<-data.frame(temp,id=seq(0:923)-1)#给省份编写id
   
7. china_mapdata<-join(mymapd, xs, type = "full") #将打散的数据以省份分组

上面我们已经读取了地图数据，你可以使用各种方法对数据进行初步探索，我们这里搁置不提。下面我们需要将年鉴数据读入内存。

1. healthdata <- read.csv("/healthmap/healthmap.csv", header = T, sep = ",", stringsAsFactors = F)#读取历史数据
   
2. healthdata <- healthdata[-c(1:4),]#去除前四行无用数据

以上我们读取了所需的年鉴数据，你可以对数据进行探索以了解数据情况，最简单的就是summary一下。

1. NAME <- healthdata$NAME #提取省份名称
   
2. hdoct <- healthdata$各地药费用 #提取各省药品费用
   
3. mydata1 <- data.frame(NAME, hdoct/100000000)
   
4. mydata1<-join(mydata1, xs, type = "full")
   
5. ## Joining by: NAME
   
6. mydata1 <- data.frame(NAME = mydata1$NAME, 各地药费用 = mydata1$hdoct, id = mydata1$id)
   
7. myepidat <- data.frame(id = unique(sort(mymapd$id)))
   
8. myepidat<-join(myepidat, mydata1, type = "full")#给地图配上数据
   
9. ## Joining by: id
   
10. temp <- data.frame(NAME = healthdata$NAME, lat = healthdata$lat, long = healthdata$long)#给各地名称一个经纬度

这里我们使用了各地省会的经纬度，我是通过网络批量查询的，你也可以通过上述地图数据获得。

1. theme_opts <- list(theme(panel.grid.minor = element_blank(),#设置网格线为空
   
2. panel.grid.major = element_blank(),#你可以去掉
   
3. panel.background = element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),#设置图版背景色
   
4. plot.background = element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),#设置绘图区背景色
   
5. panel.border = element_blank(),
   
6. legend.background = element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),
   
7. axis.line = element_blank(),
   
8. axis.text.x = element_blank(),
   
9. axis.text.y = element_blank(),
   
10. axis.ticks = element_blank(),
    
11. axis.title.x = element_blank(),
    
12. axis.title.y = element_blank(),#以上全是设置xy轴
    
13. plot.title = element_text(size=10)))
    
14. ggplot(myepidat) + geom_map(aes(map_id = id, fill = 各地药费用), color = "white", map = mymapd) +
    
15. geom_point(data = temp,aes(x = long, y = lat,fill = NULL),
    
16. colour = rgb(red = 165, green = 165, blue = 165, max = 255)) +
    
17. geom_dl(data = temp,aes(x = long, y = lat,label = NAME),
    
18. list('last.points',cex = 0.7, hjust = 1))+#设置省会标签，让省会标签随机移动一点距离以免过分重叠
    
19. scale_fill_gradient(name="",
    
20. high = rgb(red = 254, green = 67, blue = 101, max = 255),
    
21. low = rgb(red = 162, green = 162, blue = 145, max = 255),
    
22. breaks = c(0, 103, 153, 153, 202, 317, 581)) +
    
23. expand_limits(x = c(73, 136), y = c(6, 54)) + coord_map()+
    
24. theme_opts +
    
25. theme(legend.text=element_text(size=10))

以上我们做了第一个连续性变量的热点地图。下面我们做评价各省医疗水平的另外一个指标卫生技术人员数，这次我们做离散型的变量，要做到这个我们首先要卫生技术人员数这个连续性变量分类转化为离散型变量。

1. NAME <- healthdata$NAME #提取省份名称
   
2. hdoct <- healthdata$卫生技术人员 #卫生技术人员
   
3. n <- cut(hdoct, breaks = quantile(hdoct, probs = seq(0, 1,0.2)))#将卫生技术人员数据按百分位数分层
   
4. mydata1 <- data.frame(NAME, hdoct,n)
   
5. x <- unique(n)
   
6. x[6] <- n[2]
   
7. write.csv(x,"rgb.csv")
   
8. mydata1[is.na(mydata1$n) , "n"] <- n[2]
   
9. mydata1<-join(mydata1, xs, type = "full")
   
10. ## Joining by: NAME
    
11. mydata1 <- data.frame(NAME = mydata1$NAME, n = mydata1$n, id = mydata1$id)
    
12. myepidat <- data.frame(id = unique(sort(mymapd$id)))
    
13. myepidat<-join(myepidat, mydata1, type = "full")
    
14. ## Joining by: id
    
15. temp <- data.frame(NAME = healthdata$NAME, lat = healthdata$lat, long = healthdata$long)#给各地名称一个经纬度

这里我们使用了百分位数将连续性变量分层转化为分类变量，然后在根据层次做地图。

1. cols <- c(rgb(red = 131, green = 175, blue = 155, max = 255),
   
2. rgb(red = 200, green = 200, blue = 169, max = 255),
   
3. rgb(red = 249, green = 205, blue = 173, max = 255),
   
4. rgb(red = 252, green = 157, blue = 154, max = 255),
   
5. rgb(red = 254, green = 67, blue = 101, max = 255))
   
6. ggplot(myepidat) + geom_map(aes(map_id = id, fill = n), color = "white", map = mymapd) +
   
7. geom_point(data = temp,aes(x = long, y = lat,fill = NULL),
   
8. colour = rgb(red = 165, green = 165, blue = 165, max = 255)) +
   
9. geom_dl(data = temp,aes(x = long, y = lat,label = NAME),
   
10. colour = rgb(red = 38, green = 38, blue = 38, max = 255),
    
11. list('last.points',cex = 0.7, hjust = 1))+
    
12. scale_fill_manual(name = "",values = cols, labels = element_blank()) +
    
13. expand_limits(x = c(73, 136), y = c(6, 54)) + coord_map() +
    
14. theme_opts +
    
15. theme(legend.position = "bottom", legend.box = "horizontal")#legend.position=c(.5,0.9)

这幅图我们设置的主题仍然延续上一幅图的主题，所以如果你没做上一幅图，记得将theme_opts执行一遍。这次我们将图例放置在了底部，并设置了标签为空。

1. NAME <- healthdata$NAME #提取省份名称
   
2. hdoct <- healthdata$医院合计 #提取各省药品费用
   
3. mydata1 <- data.frame(NAME, hdoct)
   
4. mydata1<-join(mydata1, xs, type = "full")
   
5. ## Joining by: NAME
   
6. mydata1 <- data.frame(NAME = mydata1$NAME, 医院合计 = mydata1$hdoct, id = mydata1$id)
   
7. myepidat <- data.frame(id = unique(sort(mymapd$id)))
   
8. myepidat<-join(myepidat, mydata1, type = "full")#给地图配上数据
   
9. ## Joining by: id
   
10. temp <- data.frame(NAME = healthdata$NAME, lat = healthdata$lat, long = healthdata$long)#给各地名称一个经纬度
    
11. 我们将医院的数据仍然按连续变量做图，把数据准备好们就可以做图了，另外标签的区间仍然使用百分位数划分。
    
12. ggplot(myepidat) + geom_map(aes(map_id = id, fill = 医院合计), color = "white", map = mymapd) +
    
13. geom_point(data = temp,aes(x = long, y = lat,fill = NULL),
    
14. colour = rgb(red = 165, green = 165, blue = 165, max = 255)) +
    
15. geom_dl(data = temp,aes(x = long, y = lat,label = NAME),
    
16. list('last.points',cex = 0.7, hjust = 1))+
    
17. scale_fill_gradient(name="",
    
18. high = rgb(red = 254, green = 67, blue = 101, max = 255),
    
19. low = rgb(red = 162, green = 162, blue = 145, max = 255),
    
20. breaks = c(145, 350, 570, 915, 1174, 1783)) +
    
21. expand_limits(x = c(73, 136), y = c(6, 54)) + coord_map()+
    
22. theme_opts

这里需要注意的是连续变量'scale_fill_gradient'的填充和非连续变量scale_fill_manual的填充方式是不一样的。

1. theme_opts <- list(theme(panel.grid.minor = element_blank(),
   
2. panel.grid.major = element_blank(),
   
3. panel.background = element_blank(),
   
4. panel.background = element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),#设置图版背景色
   
5. plot.background = element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),#设置绘图区背景色
   
6. panel.border = element_blank(),
   
7. legend.background = element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),#设施图例背景色
   
8. legend.key = element_rect(colour = rgb(red = 242, green = 242, blue = 242, max = 255),
   
9. fill = rgb(red = 242, green = 242, blue = 242, max = 255)),#设置图例填充色
   
10. axis.line = element_blank(),
    
11. axis.text.x = element_blank(),
    
12. axis.text.y = element_blank(),
    
13. axis.ticks = element_blank(),
    
14. axis.title.x = element_blank(),
    
15. axis.title.y = element_blank(),
    
16. plot.title = element_text(size=10)))
    
17. p <- ggplot(data = mymapd) +
    
18. geom_polygon(aes(x = long, y = lat, group = id),
    
19. colour = rgb(red = 165, green = 165, blue = 165, max = 255),
    
20. fill = NA) +
    
21. coord_map()+
    
22. theme_opts
    
23. p <- p + geom_point(data = healthdata, aes(x=long, y=lat, size = 床位数),
    
24. position=position_jitter(width=.5, height=1),#标签位置随机移动
    
25. color=rgb(red = 254, green = 67, blue = 101, max = 255), alpha = 0.8) +
    
26. scale_size_area(name="床位数",breaks = c(104011, 106071, 150921, 188396, 300431, 489737), max_size=15)
    
27. p + geom_dl(data = healthdata,aes(x=long, y=lat,label=省会),
    
28. colour = rgb(red = 175, green = 175, blue = 175, max = 255),
    
29. list('last.points', cex = 0.8, hjust = 1))

图我们做了气泡图，并设置了变化区间breaks，取得breaks方法仍然使用百分位数，如下。

1. x <- unique(healthdata$床位数)
   
2. quantile(x, probs = seq(0, 1,0.2))

这里我们要做一个全新的地图，即地图与其他统计图形的结合。

1. temp <- data.frame(NAME = healthdata$NAME, 三级 = healthdata$三级, 二级 = healthdata$二级,
   
2. lat = healthdata$lat, long = healthdata$long)
   
3. temp <- melt(temp, id.vars=c("NAME","lat","long"))
   
4. names(temp)[names(temp) == "variable"] <- "医院级别"
   
5. names(temp)[names(temp) == "value"] <- "医院数"
   
6. prov <- c("北京市", "广东省", "江苏省","山东省","河南省","湖北省","上海市", "四川省")
   
7. subtemp <- temp[temp$NAME %in% prov,]
   
8. 以上数据算是准备好了，我们只展出重点省份

1. 条形图加地图
   
2. p <- ggplot(data = mymapd) +
   
3. geom_polygon(aes(x = long, y = lat, group = id),
   
4. colour = rgb(red = 175, green = 175, blue = 175, alph = 50, max = 255),
   
5. fill = NA) +
   
6. coord_map()+
   
7. theme_opts
   
8. p <- p + geom_dl(data = subtemp,aes(x=long-0.5, y=lat-0.5,label=NAME),
   
9. colour = rgb(red = 175, green = 175, blue = 175, max = 255),
   
10. list('last.points', cex = 0.7, hjust = 1))

#柱状图

1. p <- ggplot(data = mymapd) +
   
2. geom_polygon(aes(x = long, y = lat, group = id),
   
3. colour = rgb(red = 175, green = 175, blue = 175, alph = 50, max = 255),
   
4. fill = NA) +
   
5. coord_map()+
   
6. theme_opts
   
7. #柱状堆积图

以上我们工作了两种形式的图表：簇型柱状图和堆积图。好吧，图表就先炫到这里吧。

关于我们，关注理性与文艺，用数据创作内容性的精致阅读，这里是数据分析挖掘人员与文艺青年的集结地，不做培训，不做鼓吹，只踏踏实实的做一个又一个数据驱动的文章，并设计机器人减轻数据分析的负担，无论你感兴趣还是想参与都可以关注，请加微信公众号：dayinrushuang或扫描下方二维码

还是那句话，如果你不想关注可以留下邮箱，我整理好了会发给您，但是不要骂人，我只是想保持我写作的动力

「经管之家」APP：经管人学习、答疑、交友，就上经管之家！
免流量费下载资料----在经管之家app可以下载论坛上的所有资源，并且不额外收取下载高峰期的论坛币。
涵盖所有经管领域的优秀内容----覆盖经济、管理、金融投资、计量统计、数据分析、国贸、财会等专业的学习宝库，各类资料应有尽有。
来自五湖四海的经管达人----已经有上千万的经管人来到这里，你可以找到任何学科方向、有共同话题的朋友。
经管之家（原人大经济论坛），跨越高校的围墙，带你走进经管知识的新世界。
扫描下方二维码下载并注册APP