Geographical heat map of a custom property in R with ggmap

前端 未结 2 635
孤城傲影
孤城傲影 2020-12-09 01:05

The goal is to build something like http://rentheatmap.com/sanfrancisco.html

I got map with ggmap and able to plot points on top of it.

library(\'g         


        
2条回答
  •  渐次进展
    2020-12-09 01:15

    It looks to me like the map in the link you attached was produced using interpolation. With that in mind, I wondered if I could achieve a similar ascetic by overlaying an interpolated raster onto a ggmap.

    library(ggmap)
    library(akima) 
    library(raster) 
    
    ## data set-up from question
    map <- get_map(location=c(lon=20.46667, lat=44.81667), zoom=12, maptype='roadmap', color='bw')
    positions <- data.frame(lon=rnorm(10000, mean=20.46667, sd=0.05), lat=rnorm(10000, mean=44.81667, sd=0.05), price=rnorm(10, mean=1000, sd=300))
    positions$price <- ((20.46667 - positions$lon) ^ 2 + (44.81667 - positions$lat) ^ 2) ^ 0.5 * 10000
    positions <- data.frame(lon=rnorm(10000, mean=20.46667, sd=0.05), lat=rnorm(10000, mean=44.81667, sd=0.05))
    positions$price <- ((20.46667 - positions$lon) ^ 2 + (44.81667 - positions$lat) ^ 2) ^ 0.5 * 10000
    positions <- subset(positions, price < 1000)
    
    ## interpolate values using akima package and convert to raster
    r <- interp(positions$lon, positions$lat, positions$price, 
                xo=seq(min(positions$lon), max(positions$lon), length=100),
                yo=seq(min(positions$lat), max(positions$lat), length=100))
    r <- cut(raster(r), breaks=5) 
    
    ## plot
    ggmap(map) + inset_raster(r, extent(r)@xmin, extent(r)@xmax, extent(r)@ymin, extent(r)@ymax) +
      geom_point(data=positions, mapping=aes(lon, lat), alpha=0.2) 
    

    http://i.stack.imgur.com/qzqfu.png

    Unfortunately, I couldn't figure out how to change the color or alpha using inset_raster...probably because of my lack of familiarity with ggmap.

    EDIT 1

    This is a very interesting problem that has me scratching my head. The interpolation didn't quite have the look I thought it would when applied to real-world data; the polygon approaches by yourself and jazzurro certainly look much better!

    Wondering why the raster approach looked so jagged, I took a second look at the map you attached and noticed an apparent buffer around the data points...I wondered if I could use some rgeos tools to try and replicate the effect:

    library(ggmap)
    library(raster)
    library(rgeos)
    library(gplots)
    
    ## data set-up from question
    dat <- read.csv("clipboard") # load real world data from your link
    dat$price_cuts <- NULL
    map <- get_map(location=c(lon=median(dat$lon), lat=median(dat$lat)), zoom=12, maptype='roadmap', color='bw')
    
    ## use rgeos to add buffer around points
    coordinates(dat) <- c("lon","lat")
    polys <- gBuffer(dat, byid=TRUE, width=0.005)
    
    ## calculate mean price in each circle
    polys <- aggregate(dat, polys, FUN=mean)
    
    ## rasterize polygons
    r <- raster(extent(polys), ncol=200, nrow=200) # define grid
    r <- rasterize(polys, r, polys$price, fun=mean) 
    
    ## convert raster object to matrix, assign colors and plot
    mat <- as.matrix(r)
    colmat <- matrix(rich.colors(10, alpha=0.3)[cut(mat, 10)], nrow=nrow(mat), ncol=ncol(mat))
    ggmap(map) + 
      inset_raster(colmat, extent(r)@xmin, extent(r)@xmax, extent(r)@ymin, extent(r)@ymax) +
      geom_point(data=data.frame(dat), mapping=aes(lon, lat), alpha=0.1, cex=0.1) 
    

    enter image description here

    P.S. I found out that a matrix of colors need to be sent to inset_raster to customize the overlay

提交回复
热议问题