公众号后台回复“图书“，了解更多号主新书内容

作者：宁海涛

来源：DataCharm

今天我们再给大家介绍一个优秀的地图可视化绘制包-R-tanaka包（用于绘制具有3d阴影效果的地图可视化作品），主要涉及的内容如下：

• R-tanaka包简介及样例样式

• R-ggplot2绘制3d阴影地图

R-tanaka包简介及样例样式

tanaka包实现的方法也称为“浮雕轮廓法(relief contours method)”，“照明轮廓法(illuminated contour method)”或“阴影轮廓线方法(shaded contour lines method)”，tanaka可以通过使用阴影轮廓线来增强地图上地形的表示，使结果看上去像一个类似3D的地图效果。其官网为：https://github.com/rCarto/tanaka。其主要提供两个绘图函数，如下：

• tanaka() uses a raster object and displays t    he map directly;

• tanaka_contour() builds the isopleth polygon layer.

样例参考

这里我们直接使用官网给的样例进行可视化绘制，代码如下：

library(tanaka)
library(raster)
ras <- raster(system.file("grd/elev.grd", package = "tanaka"))
tanaka(ras, breaks = seq(80,400,20), legend.pos = "topright", legend.title = "Elevation\n(meters)")

得到的可视化结果如下：

此外，还有以下官网样例：

Example02:

library(tanaka)
library(elevatr)
# use elevatr to get elevation data
ras <- get_elev_raster(locations = data.frame(x = c(6.7, 7), y = c(45.8,46)),z = 10, prj = "+init=epsg:4326", clip = "locations")
# custom color palette
cols <- c("#F7E1C6", "#EED4C1", "#E5C9BE", "#DCBEBA", "#D3B3B6", "#CAA8B3", "#C19CAF", "#B790AB", "#AC81A7", "#A073A1", "#95639D", "#885497", "#7C4692", "#6B3D86", "#573775", "#433266", "#2F2C56", "#1B2847")
# display the map
tanaka(ras, breaks = seq(500,4800,250), col = cols)

这里需要注意的是：elevatr包可以实现在线下载DEM数据，相关代码如下：

ras <- get_elev_raster(locations = data.frame(x = c(6.7, 7), y = c(45.8,46)),z = 10, prj = "+init=epsg:4326", clip = "locations")

分别设置了位置(经纬度信息，投影等属性进行DEM数据下载)

Example3:

library(raster)
library(sf)
library(cartography)
library(tanaka)temp <- tempfile()
data_url <- "http://cidportal.jrc.ec.europa.eu/ftp/jrc-opendata/GHSL/GHS_POP_GPW4_GLOBE_R2015A/GHS_POP_GPW42015_GLOBE_R2015A_54009_1k/V1-0/GHS_POP_GPW42015_GLOBE_R2015A_54009_1k_v1_0.zip"
download.file(data_url, temp)
unzip(temp, exdir = "pop")
pop2015 <- raster("pop/GHS_POP_GPW42015_GLOBE_R2015A_54009_1k_v1_0/GHS_POP_GPW42015_GLOBE_R2015A_54009_1k_v1_0.tif")
center <- st_as_sf(data.frame(x=425483.8, y=5608290), coords=(c("x","y")), crs = st_crs(pop2015))
center <- st_buffer(center, dist = 800000)
ras <- crop(pop2015, st_bbox(center)[c(1,3,2,4)])
mat <- focalWeight(x = ras, d = c(10000), type = "Gauss")
rassmooth <- focal(x = ras, w = mat, fun = sum, pad = TRUE, padValue = 30)
bks <- c(0,25,50,100,250,500,750,1000,1750,2500,5000, 7500,10000)
png(filename = "circle.png", width = 800, height = 700, res = 100)
par(mar = c(0,0,1.2,0))
tanaka(x = rassmooth, breaks = bks, mask = center, col = hcl.colors(n = 12, palette = "Inferno"),shift = 2500,legend.pos = "topleft",legend.title = "Inhabitants\nper km2")
plot(st_geometry(center), add = T, border = "white", lwd = 6)
layoutLayer(title = "Smoothed Population Density", author = 'Data : European Commission, Joint Research Centre (JRC); Columbia University, CIESIN (2015): GHS population grid, derived from GPW4.', sources = 'T. Giraud, 2019', scale = F, frame = F, tabtitle = TRUE)
text(-374516.2 ,6408290.0, "Gaussian smoothing, sigma = 10km", adj = 0, font = 3, cex = .8 )
dev.off()

可视化结果如下：

该图绘制涉及的知识点较多(sf空间数据的基本处理，感兴趣的小伙伴可以看下sf包)

tanaka属性介绍

tanaka(x,nclass = 8,breaks,col,mask,light = "#ffffff70",dark = "#00000090",shift,legend.pos = "left",legend.title = "Elevation",add = FALSE
)#解释如下：
Arguments
x ：a raster or an sf contour layer (e.g. the result of tanaka_contour()).
(栅格数据或sf轮廓图层（例如tanaka_contour（）的结果)
nclass ：a number of class.
(等级)
breaks ：a vector of break values.
(刻度值)
col ：a color palette (a vector of colors).
(调色板（颜色向量）)
mask ：a mask layer, a POLYGON or MULTIPOLYGON sf object.
(掩码，POLYGON或MULTIPOLYGON的sf对象。)
light ：light shadow (NW color).
(浅阴影（NW颜色）)
dark ：dark shadow (SE color).
(暗阴影（SE颜色）)
shift ：size of the shadow (in map units).
(阴影的大小（以地图单位为单位）)
legend.pos ：position of the legend, one of "topleft", "top", "topright", "right", "bottomright", "bottom", "bottomleft", "left" or a vector of two coordinates in map units (c(x, y)). If legend.pos="n" then the legend is not plotted.
(图例的位置，“上左”，“上”，“上右”，“右”，“下右”，“下”，“下左”，“左”或以地图单位表示的两个坐标的向量（c（ x，y））。 如果legend.pos =“ n”，则不会绘制图例。)
legend.title ：title of the legend.
(图例标题)
add ：whether to add the layer to an existing plot (TRUE) or not (FALSE).
(是否将将图层添加到已存在的图上)

R-ggplot2绘制3d阴影地图

tanaka 包毕竟是一个小众地图可视化包，如何能使用ggplot2以及拓展包绘制类似地图效果呢？答案是可以的，我们可以使用metR包实现该3d地图效果，我们还是以上面的数据为例，首先，我们需要将数据转换成data.frame类型。

数据处理

我们对使用raster包读取的栅格数据ras进行转换：

ras_df <- as.data.frame(ras,xy = TRUE)
names(ras_df) <- c("lon",'lat',"Elevation")
head(ras_df)

接下来我们就可以使用ggplot2进行绘制了，这里我们直接给出定制化操作的代码及可视化结果：

library(metR)
library(ggplot2)
library(RColorBrewer)
library(ggtext)
library(showtext)
library(hrbrthemes)my_colormap <- colorRampPalette(rev(brewer.pal(11,'Spectral')))(32)map_3d <- ggplot(ras_df, aes(x = lon, y = lat)) +geom_contour_fill(aes(z = Elevation)) +geom_contour_tanaka(aes(z = Elevation),breaks = seq(80,400,20)) +scale_fill_gradientn(colours = my_colormap,name="DEM(m)") +#scale_fill_gradient2(low = "#FBDEE1",high = "#1D0809",breaks=seq(80,400,20)) +labs(x="",y="",title = "Example of <span style='color:#D20F26'>metR::geom_contour_tanaka function</span>",subtitle = "processed map charts with <span style='color:#1A73E8'>geom_contour_tanaka()</span>",caption = "Visualization by <span style='color:#DD6449'>DataCharm</span>") +theme_ipsum(base_family = "Roboto Condensed") +#theme_ft_rc()+theme( plot.title = element_markdown(hjust = 0.5,vjust = .5,color = "black",size = 20, margin = margin(t = 1, b = 12)),plot.subtitle = element_markdown(hjust = 0,vjust = .5,size=15),plot.caption = element_markdown(face = 'bold',size = 12),)

最终的可视化效果如下：

当然你可可以更换主题，效果如下：

总结

本期推文，我们继续介绍了优秀的R可视化绘制包-tanaka包以及metR包结合ggplot2实现更加自由的定制化可视化作品绘制，希望大家可以从中获取获取绘图灵感。

◆ ◆ ◆  ◆ ◆麟哥新书已经在当当上架了，我写了本书：《拿下Offer-数据分析师求职面试指南》，目前当当正在举行活动，大家可以用相当于原价5折的预购价格购买，还是非常划算的：

数据森麟公众号的交流群已经建立，许多小伙伴已经加入其中，感谢大家的支持。大家可以在群里交流关于数据分析&数据挖掘的相关内容，还没有加入的小伙伴可以扫描下方管理员二维码，进群前一定要关注公众号奥，关注后让管理员帮忙拉进群，期待大家的加入。
管理员二维码：
猜你喜欢
● 卧槽！原来爬取B站弹幕这么简单● 厉害了！麟哥新书登顶京东销量排行榜！● 笑死人不偿命的知乎沙雕问题排行榜
● 用Python扒出B站那些“惊为天人”的阿婆主！● 你相信逛B站也能学编程吗