目标是建立类似
http://rentheatmap.com/sanfrancisco.html
我得到了带有ggmap的地图,并能够在其上面绘制点。
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)
基于密度,这是一个不错的图像。是否有人知道如何制作看起来相同但使用position $ property来构建轮廓和比例的东西?
我通过stackoverflow.com进行了彻底查看,但没有找到解决方案。
编辑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")
得出五个独立的stat_density图:
编辑2(来自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)
结果是:
它也可以在真实数据上创建一个体面的画面。这是迄今为止最好的结果。欢迎更多建议。
编辑3:
以下是上述方法的测试数据和结果:
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")
我相信应该有一些使用密度核以外的方法来计算适当的多边形的方法。似乎该功能应该在开箱即用的ggplot中,但我找不到它。
编辑4:
我感谢您花费时间和精力为这个看似不太复杂的问题找到适当的解决方案。我对您的两个答案都投了赞成票,以达到目标。
我揭示了一个问题:带圆圈的数据过于人为,并且这些方法在读取世界数据时效果不佳。
保罗的方法给了我这个情节:
看来它捕获了很酷的数据模式。
爵士乐的支持给了我这个情节:
它也有模式。但是,两个图似乎都没有默认的stat_density2d图漂亮。我仍将等待几天,以查看是否有其他解决方案。如果没有,我将奖励jazzurro,因为这将是我坚持使用的结果。
有一个开放的python + google_maps版本的必需代码。可能有人会在这里找到灵感:
https://github.com/jeffkaufman/apartment_prices
最佳答案
在我看来,您所附加的链接中的地图是使用插值生成的。考虑到这一点,我想知道是否可以通过将插值栅格叠加到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
不幸的是,我无法弄清楚如何使用inset_raster来改变颜色或Alpha ...可能是由于我对ggmap缺乏了解。
编辑1
这是一个非常有趣的问题,我不得不挠头。当应用于实际数据时,插值并没有我认为的样子。多边形自己靠近,jazzurro肯定看起来好多了!
想知道为什么栅格方法看起来如此参差不齐,我再次看了看您附加的地图,发现数据点周围有明显的缓冲区...我想知道是否可以使用一些rgeos工具来尝试并复制效果:
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)
附言我发现需要将颜色矩阵发送到inset_raster以自定义叠加层