mappa di calore geografica di una proprietà personalizzata in R con ggmap

Question

L'obiettivo è quello di costruire qualcosa di simile http://rentheatmap.com/sanfrancisco.html

ho ottenuto mappa con ggmap e in grado di tracciare i punti su di esso.

library('ggmap') 
map <- get_map(location=c(lon=20.46667, lat=44.81667), zoom=12, maptype='roadmap', color='bw') 
positions <- data.frame(lon=rnorm(100, mean=20.46667, sd=0.05), lat=rnorm(100, mean=44.81667, sd=0.05), price=rnorm(10, mean=1000, sd=300)) 
ggmap(map) + geom_point(data=positions, mapping=aes(lon, lat)) + stat_density2d(data=positions, mapping=aes(x=lon, y=lat, fill=..level..), geom="polygon", alpha=0.3) 

Questa è una bella immagine in base alla densità. Qualcuno sa come creare qualcosa che sembra uguale, ma usa position $ property per costruire contorni e scale?

Ho guardato a fondo attraverso stackoverflow.com e non ho trovato una soluzione.

EDIT 1

positions$price_cuts <- cut(positions$price, breaks=5) 
ggmap(map) + stat_density2d(data=positions, mapping=aes(x=lon, y=lat, fill=price_cuts), alpha=0.3, geom="polygon") 

risultati in cinque appezzamenti stat_density indipendenti:

EDIT 2 (da hrbrmstr)

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) 
positions$price_cuts <- cut(positions$price, breaks=5) 
ggmap(map) + geom_hex(data=positions, aes(fill=price_cuts), alpha=0.3) 

si traduce in:

Crea un'immagine decente anche sui dati reali. Questo è il miglior risultato finora. Altri suggerimenti sono benvenuti.

EDIT 3: Ecco i dati di test e risultati di un metodo di cui sopra:

https://raw.githubusercontent.com/artem-fedosov/share/master/kernel_smoothing_ggplot.csv

test<-read.csv('test.csv') 
ggplot(data=test, aes(lon, lat, fill=price_cuts)) + stat_bin2d(, alpha=0.7) + geom_point() + scale_fill_brewer(palette="Blues") 

Credo che non ci dovrebbero un certo metodo che usi diversi densità kernel per calcolare poligoni appropriati. Sembra che la funzione dovrebbe essere in ggplot, ma non riesco a trovarla.

EDIT 4: Apprezzo il tempo e lo sforzo per capire la soluzione adeguata a questa domanda apparentemente non troppo complicata. Ho votato entrambe le tue risposte come una buona approssimazione all'obiettivo.

Ho rilevato un problema: i dati con i cerchi sono troppo artificiali e gli approcci non funzionano altrettanto bene sui dati del mondo di lettura.

approccio di Paolo mi ha dato la trama:

Sembra che cattura i modelli di dati che è cool. approage

di jazzurro mi ha dato questa trama:

Ha ottenuto i modelli pure. Tuttavia, entrambi i grafici non sembrano così belli come la trama stat_density2d di default. Aspetterò ancora un paio di giorni per vedere se emergerà qualche altra soluzione.In caso contrario, assegnerò la taglia a jazzurro in quanto sarà il risultato che userò.

C'è una versione python + google_maps aperta del codice richiesto. Forse qualcuno troverà ispirazione qui: https://github.com/jeffkaufman/apartment_prices

Answer 1

Sembra a me come la mappa nel link è stato collegato è stato prodotto mediante interpolazione. Con questo in mente, mi chiedevo se avrei potuto ottenere un asceta simile sovrapponendo un raster interpolato su una 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

Purtroppo, non riusciva a capire come cambiare il colore o alpha utilizzando inset_raster ... probabilmente a causa della mia mancanza di familiarità con ggmap.

EDIT 1

Questo è un problema molto interessante che mi ha graffiare la mia testa. L'interpolazione non aveva proprio l'aspetto che pensavo avrebbe applicato ai dati del mondo reale; il poligono si avvicina da solo e jazzurro sicuramente sembra molto meglio!

Mi chiedevo perché l'approccio raster fosse così frastagliato, ho dato una seconda occhiata alla mappa che hai allegato e ho notato un apparente buffer attorno ai punti dati ... Mi chiedevo se avrei potuto usare alcuni strumenti rgeos per provare a replicare l'effetto :

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) 

PS Ho scoperto che una matrice di colori deve essere inviata a inset_raster per personalizzare l'overlay

Answer 2

Ecco il mio approccio. L'approccio geom_hex è bello. Quando è uscito, mi è davvero piaciuto. Faccio ancora. Dal momento che hai chiesto qualcosa in più ho provato quanto segue. Penso che il mio risultato sia simile a quello con stat_density2d. Ma, potrei evitare i problemi che hai avuto. Fondamentalmente ho creato uno shapefile da solo e ho disegnato poligoni. Ho inserito i dati per fascia di prezzo (price_cuts) e ho disegnato poligoni dal bordo al centro della zona. Questo approccio è nella riga di EDIT 1 e 2. Penso che ci sia ancora una certa distanza per raggiungere il tuo obiettivo finale se vuoi disegnare una mappa con una vasta area. Ma, spero che questo ti permetta di andare avanti. Infine, vorrei ringraziare un paio di utenti SO che hanno fatto grandi domande relative ai poligoni. Non ho potuto trovare questa risposta senza di loro.

library(dplyr) 
library(data.table) 
library(ggmap) 
library(sp) 
library(rgdal) 
library(ggplot2) 
library(RColorBrewer) 


### Data set by the OP 
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) 


### Data arrangement 
positions$price_cuts <- cut(positions$price, breaks=5) 
positions$price_cuts <- as.character(as.integer(positions$price_cuts)) 

### Create a copy for now 
ana <- positions 

### Step 1: Get a map 
map <- get_map(location=c(lon=20.46667, lat=44.81667), zoom=11, maptype='roadmap', color='bw') 

### Step 2: I need to create SpatialPolygonDataFrame using the original data. 
### http://stackoverflow.com/questions/25606512/create-polygon-from-points-and-save-as-shapefile 
### For each price zone, create a polygon, SpatialPolygonDataFrame, and convert it 
### it data.frame for ggplot. 

cats <- list() 

for(i in unique(ana$price_cuts)){ 

foo <- ana %>% 
     filter(price_cuts == i) %>% 
     select(lon, lat) 

    ch <- chull(foo) 
    coords <- foo[c(ch, ch[1]), ] 

    sp_poly <- SpatialPolygons(list(Polygons(list(Polygon(coords)), ID=1))) 

    bob <- fortify(sp_poly) 

    bob$area <- i 

    cats[[i]] <- bob 
} 

cathy <- as.data.frame(rbindlist(cats)) 


### Step 3: Draw a map 
### The key thing may be that you subet data for each price_cuts and draw 
### polygons from outer side given the following link. 
### This link was great. This is exactly what I was thinking. 
### http://stackoverflow.com/questions/21748852/choropleth-map-in-ggplot-with-polygons-that-have-holes 

ggmap(map) + 
    geom_polygon(aes(x = long, y = lat, group = group, fill = as.numeric(area)), 
       alpha = .3, 
       data = subset(cathy, area == 5))+ 
    geom_polygon(aes(x = long, y = lat, group = group, fill = as.numeric(area)), 
       alpha = .3, 
       data =subset(cathy, area == 4))+ 
    geom_polygon(aes(x = long, y = lat, group = group, fill = as.numeric(area)), 
       alpha = .3, 
       data = subset(cathy, area == 3))+ 
    geom_polygon(aes(x = long, y = lat, group = group, fill = as.numeric(area)), 
       alpha = .3, 
       data = subset(cathy, area == 2))+ 
    geom_polygon(aes(x = long, y = lat, group = group, fill = as.numeric(area)), 
       alpha= .3, 
       data = subset(cathy, area == 1))+ 
    geom_point(data = ana, aes(x = lon, y = lat), size = 0.3) +        
    scale_fill_gradientn(colours = brewer.pal(5,"Spectral")) + 
    scale_x_continuous(limits = c(20.35, 20.58), expand = c(0, 0)) + 
    scale_y_continuous(limits = c(44.71, 44.93), expand = c(0, 0)) + 
    guides(fill = guide_legend(title = "Property price zone"))