R: Cách xây dựng bản đồ nhiệt với gói tờ rơi

Tôi đọc một bài viết về bản đồ tương tác với R bằng cách sử dụng leafletgói.

Trong bài viết này, tác giả tạo ra một bản đồ nhiệt như thế này:

X=cbind(lng,lat)
kde2d <- bkde2D(X, bandwidth=c(bw.ucv(X[,1]),bw.ucv(X[,2])))

x=kde2d$x1
y=kde2d$x2
z=kde2d$fhat
CL=contourLines(x , y , z)

m = leaflet() %>% addTiles() 
m %>% addPolygons(CL[[5]]$x,CL[[5]]$y,fillColor = "red", stroke = FALSE)

Tôi không quen với bkde2Dchức năng này, vì vậy tôi tự hỏi liệu mã này có thể được khái quát hóa cho bất kỳ shapefile nào không?

Điều gì xảy ra nếu mỗi nút có trọng lượng riêng, mà chúng tôi muốn thể hiện trên bản đồ nhiệt?

Có cách nào khác để tạo bản đồ nhiệt với leafletbản đồ trong R không?

Đây là cách tiếp cận của tôi để tạo bản đồ nhiệt tổng quát hơn trong Leaflet bằng R. Cách tiếp cận này sử dụng contourLines, giống như bài đăng trên blog đã đề cập trước đây, nhưng tôi sử dụng lapplyđể lặp lại tất cả các kết quả và chuyển đổi chúng thành đa giác chung. Trong ví dụ trước, người dùng có thể vẽ riêng từng đa giác, vì vậy tôi sẽ gọi đây là "tổng quát hơn" (ít nhất đây là khái quát mà tôi muốn khi đọc bài đăng trên blog!).

## INITIALIZE
library("leaflet")
library("data.table")
library("sp")
library("rgdal")
# library("maptools")
library("KernSmooth")

inurl <- "https://data.cityofchicago.org/api/views/22s8-eq8h/rows.csv?accessType=DOWNLOAD"
infile <- "mvthefts.csv"

## LOAD DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
    download.file(url = inurl, destfile = infile)
}
dat <- data.table::fread(infile)
setnames(dat, tolower(colnames(dat)))
setnames(dat, gsub(" ", "_", colnames(dat)))
dat <- dat[!is.na(longitude)]
dat[ , date := as.IDate(date, "%m/%d/%Y")]

## MAKE CONTOUR LINES
## Note, bandwidth choice is based on MASS::bandwidth.nrd()
kde <- bkde2D(dat[ , list(longitude, latitude)],
              bandwidth=c(.0045, .0068), gridsize = c(100,100))
CL <- contourLines(kde$x1 , kde$x2 , kde$fhat)

## EXTRACT CONTOUR LINE LEVELS
LEVS <- as.factor(sapply(CL, `[[`, "level"))
NLEV <- length(levels(LEVS))

## CONVERT CONTOUR LINES TO POLYGONS
pgons <- lapply(1:length(CL), function(i)
    Polygons(list(Polygon(cbind(CL[[i]]$x, CL[[i]]$y))), ID=i))
spgons = SpatialPolygons(pgons)

## Leaflet map with polygons
leaflet(spgons) %>% addTiles() %>% 
    addPolygons(color = heat.colors(NLEV, NULL)[LEVS])

Đây là những gì bạn sẽ có tại thời điểm này:

## Leaflet map with points and polygons
## Note, this shows some problems with the KDE, in my opinion...
## For example there seems to be a hot spot at the intersection of Mayfield and
## Fillmore, but it's not getting picked up.  Maybe a smaller bw is a good idea?

leaflet(spgons) %>% addTiles() %>%
    addPolygons(color = heat.colors(NLEV, NULL)[LEVS]) %>%
    addCircles(lng = dat$longitude, lat = dat$latitude,
               radius = .5, opacity = .2, col = "blue")

Và đây là bản đồ nhiệt với các điểm sẽ như thế nào:

Đây là một khu vực gợi ý cho tôi rằng tôi cần điều chỉnh một số tham số hoặc có thể sử dụng một kernel khác:

## Leaflet map with polygons, using Spatial Data Frame
## Initially I thought that the data frame structure was necessary
## This seems to give the same results, but maybe there are some 
## advantages to using the data.frame, e.g. for adding more columns
spgonsdf = SpatialPolygonsDataFrame(Sr = spgons,
                                    data = data.frame(level = LEVS),
                                    match.ID = TRUE)
leaflet() %>% addTiles() %>%
    addPolygons(data = spgonsdf,
                color = heat.colors(NLEV, NULL)[spgonsdf@data$level])

Dựa trên câu trả lời của genorama ở trên, bạn cũng có thể chuyển đổi đầu ra của bkde2D thành raster chứ không phải đường viền, sử dụng các giá trị fhat làm giá trị ô raster

library("leaflet")
library("data.table")
library("sp")
library("rgdal")
# library("maptools")
library("KernSmooth")
library("raster")

inurl <- "https://data.cityofchicago.org/api/views/22s8-eq8h/rows.csv?accessType=DOWNLOAD"
infile <- "mvthefts.csv"

## LOAD DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
  download.file(url = inurl, destfile = infile)
}
dat <- data.table::fread(infile)
setnames(dat, tolower(colnames(dat)))
setnames(dat, gsub(" ", "_", colnames(dat)))
dat <- dat[!is.na(longitude)]
dat[ , date := as.IDate(date, "%m/%d/%Y")]

## Create kernel density output
kde <- bkde2D(dat[ , list(longitude, latitude)],
              bandwidth=c(.0045, .0068), gridsize = c(100,100))
# Create Raster from Kernel Density output
KernelDensityRaster <- raster(list(x=kde$x1 ,y=kde$x2 ,z = kde$fhat))

#create pal function for coloring the raster
palRaster <- colorNumeric("Spectral", domain = KernelDensityRaster@data@values)

## Leaflet map with raster
leaflet() %>% addTiles() %>% 
  addRasterImage(KernelDensityRaster, 
                 colors = palRaster, 
                 opacity = .8) %>%
  addLegend(pal = palRaster, 
            values = KernelDensityRaster@data@values, 
            title = "Kernel Density of Points")

Đây là đầu ra của bạn. Lưu ý rằng các giá trị mật độ thấp vẫn hiển thị như được tô màu trong raster.

Chúng ta có thể loại bỏ các ô mật độ thấp này bằng cách sau:

#set low density cells as NA so we can make them transparent with the colorNumeric function
 KernelDensityRaster@data@values[which(KernelDensityRaster@data@values < 1)] <- NA

#create pal function for coloring the raster
palRaster <- colorNumeric("Spectral", domain = KernelDensityRaster@data@values, na.color = "transparent")

## Redraw the map
leaflet() %>% addTiles() %>% 
  addRasterImage(KernelDensityRaster, 
                 colors = palRaster, 
                 opacity = .8) %>%
  addLegend(pal = palRaster, 
            values = KernelDensityRaster@data@values, 
            title = "Kernel Density of Points")

Bây giờ bất kỳ ô raster nào có giá trị nhỏ hơn 1 đều trong suốt.

Nếu bạn muốn một raster binned, hãy sử dụng hàm colorBin thay vì hàm colorNumeric:

palRaster <- colorBin("Spectral", bins = 7, domain = KernelDensityRaster@data@values, na.color = "transparent")

## Leaflet map with raster
leaflet() %>% addTiles() %>% 
  addRasterImage(KernelDensityRaster, 
                 colors = palRaster, 
                 opacity = .8) %>%
  addLegend(pal = palRaster, 
            values = KernelDensityRaster@data@values, 
            title = "Kernel Density of Points")

Để làm cho nó mượt mà hơn, chỉ cần tăng lưới trong hàm bkde2D. Điều này làm tăng độ phân giải của raster được tạo. (Tôi đã đổi nó thành

gridsize = c(1000,1000)

Đầu ra:

Một cách dễ dàng để tạo bản đồ nhiệt Leaflet trong R là sử dụng plugin Leaflet.heat . Một hướng dẫn tuyệt vời về cách sử dụng nó có thể được tìm thấy ở đây . Hi vọng bạn tìm được thứ hữu dụng.