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

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)")

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)

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")

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(
  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).
(是否将将图层添加到已存在的图上)

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

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),
      )