R: Cómo construir un mapa de calor con el paquete de folleto

10

Leí una publicación sobre mapas interactivos con R usando el leafletpaquete.

En este artículo, el autor crea un mapa de calor como este:

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)

No estoy familiarizado con la bkde2Dfunción, así que me pregunto si este código podría generalizarse a algún shapefile.

¿Qué sucede si cada nodo tiene un peso específico que nos gustaría representar en el mapa de calor?

¿Hay otras formas de crear un mapa de calor con un leafletmapa en R?

Felipe
fuente
bke2d le permite hacer binning 2d (estimación de densidad del núcleo) para un conjunto de puntos (para que los pares lng / lat funcionen bien). el paquete ks admite el suavizado del núcleo para datos de 1 a 6 dimensiones. el paquete akima puede hacer interpolación (útil cuando necesita una grilla regular). Puede valer la pena leer sobre la vista de tareas espaciales para esto antes de intentar producir algo que no represente los datos correctamente.
hrbrmstr
ok, gracias por el enlace, definitivamente miraré esto. En realidad, la función bke2d no funciona tan bien con mis datos como en el ejemplo, y no puedo entender por qué.
Felipe

Respuestas:

10

Este es mi enfoque para hacer un mapa de calor más generalizado en Leaflet usando R. Este enfoque usa contourLines, como la publicación de blog mencionada anteriormente, pero uso lapplypara iterar sobre todos los resultados y convertirlos en polígonos generales. En el ejemplo anterior, depende del usuario trazar individualmente cada polígono, por lo que llamaría a esto "más generalizado" (¡al menos esta es la generalización que quería cuando leía la publicación del 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])

Esto es lo que tendrás en este punto: ingrese la descripción de la imagen aquí

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

Y así es como se vería el mapa de calor con puntos:

ingrese la descripción de la imagen aquí

Aquí hay un área que me sugiere que necesito ajustar algunos parámetros o quizás usar un núcleo diferente:

ingrese la descripción de la imagen aquí

## 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])
geneorama
fuente
Recorrí las redes que intentaban resolver esto y este fue, con mucho, el mejor ejemplo que encontré. Lo conecté a mi código y "simplemente funcionó". Increíble. ¡Gracias!
Jeff Allen
¡Gracias! De hecho, he creado un repositorio con varios otros ejemplos de mapas que podrían ser útiles para otros github.com/geneorama/wnv_map_demo
geneorama
Gracias por este mini tutorial. ¿Cómo seleccionó el bandwidthde bkde2d()?
the_darkside
2
@the_darkside gran pregunta. En realidad, jugueteo con él hasta que obtengo algo que me gusta, originalmente desarrollé este mapa específicamente para examinar los supuestos de ancho de banda. En este caso, realmente utilicé MASS::bandwidth.nrd(dat$latitude)y MASS::bandwidth.nrd(dat$longitude)como puntos de partida. Consulte la ?MASS::kde2ddocumentación a la que se vincula bandwith.nrd. También vea ?KernSmooth::dpiksi está interesado en otro enfoque.
geneorama
si gridsize = c(100,100)eso significa que hay un total de 10,000 células?
the_darkside
4

Partiendo de la respuesta de genorama anterior, también puede convertir la salida de bkde2D en un ráster en lugar de líneas de contorno, utilizando los valores fhat como valores de celda ráster

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

Esta es tu salida. Tenga en cuenta que los valores de baja densidad aún se muestran como coloreados en el ráster.

Salida ráster

Podemos eliminar estas celdas de baja densidad con lo siguiente:

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

Ahora cualquier celda ráster con un valor inferior a 1 es transparente.

Mapa final

Si desea un ráster agrupado, use la función colorBin en lugar de la función 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")

Densidad de kernel ráster binned

Para hacerlo más suave, simplemente aumente el tamaño de la cuadrícula en la función bkde2D. Esto aumenta la resolución del ráster generado. (Lo cambié a

gridsize = c(1000,1000)

Salida:

Ráster suavizado

Jacob Sanua
fuente
¿Cómo puede convertir la descripción de la leyenda "Kernel Density of Points" en algo más intuitivo, como "Robos por km cuadrado"? Supongo que hay una ecuación que vincula el ancho de banda, el tamaño de cuadrícula y la proyección, o tal vez incluso kdf $ fhat que describe las unidades.
fifthace
3

Una manera fácil de crear mapas de calor de Leaflet en R es usar el complemento Leaflet.heat . Puede encontrar una excelente guía sobre cómo usarlo aquí . Esperamos que te sea útil.

Sam
fuente