具有给定颜色值的空间热图

Question

我以此 thread 为基础绘制空间热图。不同之处在于我不想计算点的密度，因为我已经有了“热量”水平的值。详细地说，我想用颜色渐变绘制伯尔尼州（瑞士）的人口密度。

人口数据来自瑞士统计局，计算每公顷（100 米 x 100 平方米）的居民，可在此处下载（“STATPOP2020.csv”文件） .基于 thread 中的 jlhoward 答案，我目前的代码是：

library(tidyverse)
library(rgdal)
library(GADMTools)
library(RColorBrewer) 

# conversion from swiss coordinate system to wgs-84
lv03_wgs_lat <- function (y, x){
  y_aux <- (y - 600000)/1000000
  x_aux <- (x - 200000)/1000000
  lat <- {16.9023892 +
      3.238272 * x_aux -
      0.270978 * (y_aux^2) -
      0.002528 * (x_aux^2) -
      0.0447   * (y_aux^2) * x_aux -
      0.0140   * (x_aux^3)}
  lat <- lat * 100/36
  return(lat)  
}

lv03_wgs_lon <- function (y, x){
  y_aux <- (y - 600000)/1000000
  x_aux <- (x - 200000)/1000000
  lon <- {2.6779094 +
      4.728982 * y_aux +
      0.791484 * y_aux * x_aux +
      0.1306   * y_aux * (x_aux^2) -
      0.0436   * (y_aux^3)}
  lon <- lon * 100/36
  return(lon)
}

# read in data
d_pop <- read_csv2("STATPOP2020.csv") %>%
  select(1:6) %>%
  rename(TOT = 6) %>%
  mutate(lon = lv03_wgs_lon(X_KOORD, Y_KOORD),
         lat = lv03_wgs_lat(X_KOORD, Y_KOORD))

# filter swiss data to canton of berne
d_map_ch <- gadm_sf.loadCountries("CHE", level = 1)
d_map_be <- gadm_subset(d_map_ch, level = 1, regions = "Bern", usevar = NULL)
d_map_points <- st_as_sf(d_pop, coords = c("lon", "lat"), crs = 4326)
d_pop_be <- bind_cols(d_pop,
                      as_tibble(t(st_contains(x = d_map_be$sf, y = d_map_points, sparse = FALSE))) %>%
                        rename(in_be = V1)) %>%
  filter(in_be)

# building on previous answer, administrative border is disregarded
ggplot(d_pop_be, aes(x = E_KOORD, y = N_KOORD)) + 
  stat_density2d(aes(fill = TOT), alpha = 0.4, geom = "polygon")+
  scale_fill_gradientn(colours=rev(brewer.pal(7,"Spectral")))+
  xlim(2555000, 2678000) +
  ylim(1130000, 1245000) +
  coord_fixed()

在绘制热图时，我没有得到“热度”、人口密度的图例，而且我无法为渐变添加颜色。有人知道如何添加这些吗？

Answer 1

正如您已经确定的那样，问题是您想要一个代表人口密度的等高线图，而不是 测量值 的密度，这就是 stat_density_2d做。可以在 R 中创建这样的对象，但是当测量值在网格上没有规则间隔时（如此数据的情况），这很困难。出于这个原因，最好在这里使用 geom_point：

ggplot(d_pop_be, aes(x = E_KOORD, y = N_KOORD)) + 
  geom_point(aes(color = log(TOT), alpha = exp(TOT))) +
  scale_colour_gradientn(colours=rev(brewer.pal(7,"Spectral")),
                         breaks = log(c(1, 10, 100, 1000)),
                         labels = c(1, 10, 100, 1000),
                         name = "Population density\n(People per hectare)")+
  xlim(2555000, 2678000) +
  ylim(1130000, 1245000) +
  guides(alpha = guide_none()) +
  coord_fixed()

如果您想要填充轮廓，则必须手动创建一个覆盖感兴趣区域的矩阵，获取每个箱中的平均人口，将其转换为数据框，然后使用 geom_contour_filled:

z <- tapply(d_pop_be$TOT, list(cut(d_pop_be$E_KOORD, 200), 
                               cut(d_pop_be$N_KOORD, 200)), mean, na.rm = TRUE)

df <- expand.grid(x = seq(min(d_pop_be$E_KOORD), max(d_pop_be$E_KOORD), length = 200),
                  y = seq(min(d_pop_be$N_KOORD), max(d_pop_be$N_KOORD), length = 200))


df$z <- c(tapply(d_pop_be$TOT, list(cut(d_pop_be$E_KOORD, 200), 
                  cut(d_pop_be$N_KOORD, 200)), mean, na.rm = TRUE))

df$z[is.na(df$z)] <- 0

 ggplot(df, aes(x, y)) + 
 geom_contour_filled(aes(z = z), breaks = c(1, 5, 20, 50, 100, 1000)) +
 scale_fill_manual(values = rev(brewer.pal(5, "Spectral")))

具有给定颜色值的空间热图

Spatial heatmap with given value for colour

r

heatmap

spatial

rgdal