地图可视化绘制 | R-tanaka/metR包绘制3D阴影效果地图

news/发布时间2024/4/29 5:15:32

今天我们再给大家介绍一个优秀的地图可视化绘制包-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)")

得到的可视化结果如下：

tanaka example1

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

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)

tanaka example2

这里需要注意的是：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()

可视化结果如下：

tanaka example3

该图绘制涉及的知识点较多(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),)

最终的可视化效果如下：