ggmap

Question

लक्ष्य के साथ आर में कोई कस्टम गुण की भौगोलिक हीट मैप की तरह 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) 

यह घनत्व के आधार पर एक अच्छा छवि है। क्या कोई जानता है कि ऐसा कुछ कैसे दिखाना है, लेकिन समरूपता और स्केल बनाने के लिए स्थिति $ संपत्ति का उपयोग करता है?

मैंने 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: मैं इस जटिल रूप से जटिल प्रश्न के उचित समाधान को समझने के लिए आपको समय और प्रयास की सराहना करता हूं। मैंने आपके उत्तरों को लक्ष्य के लिए एक अच्छा अनुमान के रूप में वोट दिया।

मैंने एक समस्या का खुलासा किया: सर्कल के साथ डेटा बहुत कृत्रिम है और दृष्टिकोण पढ़ने वाले विश्व डेटा पर यह अच्छा प्रदर्शन नहीं करते हैं।

पॉल दृष्टिकोण मुझे साजिश दिया:

ऐसा लगता है कि यह डेटा अच्छा है कि के पैटर्न कैप्चर करता है।

यह रूप में अच्छी तरह पैटर्न मिल गया:

jazzurro के approage मुझे इस साजिश दे दी है। हालांकि, दोनों भूखंड डिफ़ॉल्ट stat_density2d प्लॉट के रूप में सुंदर नहीं लगते हैं। मैं अभी भी कुछ दिनों का इंतजार करूँगा यह देखने के लिए कि कोई अन्य समाधान आएगा या नहीं।यदि नहीं, तो मैं जैज़ूरो को बक्षीस दूंगा क्योंकि यह परिणाम होगा जिसका उपयोग मैं करूँगा।

आवश्यक कोड का एक खुला पायथन + google_maps संस्करण है। हो सकता है कि कोई व्यक्ति यहां प्रेरणा पायेगा: https://github.com/jeffkaufman/apartment_prices

Answer 1

यह लिंक आप संलग्न प्रक्षेप का उपयोग कर उत्पादन किया गया था में नक्शे की तरह मुझे लग रहा है। इस बात को ध्यान में रखते हुए, मुझे आश्चर्य हुआ कि क्या मैं एक जीजीएमएपी पर एक इंटरप्लाटेड रास्टर को ओवरले करके एक समान तपस्वी प्राप्त कर सकता हूं।

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

दुर्भाग्य से, मैं समझ नहीं सकता कैसे शायद ggmap के साथ परिचित की मेरी कमी की वजह से inset_raster का उपयोग कर रंग या अल्फा को बदलने के लिए ...।

संपादित करें 1

यह एक बहुत ही दिलचस्प समस्या है जो मुझे मेरे सिर खरोंच है। इंटरपोलेशन में काफी नज़र नहीं थी, मैंने सोचा कि यह वास्तविक दुनिया डेटा पर लागू होने पर होगा; अपने आप से बहुभुज दृष्टिकोण और जैज़ुरो निश्चित रूप से बहुत बेहतर दिखते हैं!

आश्चर्य है कि रास्टर दृष्टिकोण इतने जबरदस्त क्यों दिखता है, मैंने आपके द्वारा लगाए गए मानचित्र पर एक दूसरा रूप लिया और डेटा बिंदुओं के चारों ओर एक स्पष्ट बफर देखा ... मुझे आश्चर्य हुआ कि क्या मैं प्रभाव को दोहराने और दोहराने के लिए कुछ रेजीओ टूल का उपयोग कर सकता हूं :

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) 

पी एस मुझे पता चला कि ओवरले

Answer 2

मेरा दृष्टिकोण यहां है। geom_hex दृष्टिकोण अच्छा है। जब वह बाहर आया, मुझे वास्तव में यह पसंद आया। मैं अभी भी कर रहा हूं। चूंकि आपने कुछ और पूछा है, इसलिए मैंने निम्नलिखित की कोशिश की। मुझे लगता है कि मेरा परिणाम stat_density2d के साथ एक जैसा है। लेकिन, मैं आपके मुद्दों से बच सकता था। मैंने मूल रूप से एक आकारफाइल बनाया और बहुभुज खींचा। मैंने मूल्य क्षेत्र (price_cuts) द्वारा डेटा को सब्सक्राइब किया और किनारे से ज़ोन केंद्र तक बहुभुज खींचा। यह दृष्टिकोण EDIT 1 और 2 की रेखा में है। मुझे लगता है कि यदि आप बड़े क्षेत्र के साथ मानचित्र बनाना चाहते हैं तो अपने अंतिम लक्ष्य तक पहुंचने के लिए अभी भी कुछ दूरी है। लेकिन, मुझे उम्मीद है कि यह आपको आगे बढ़ने देगा। अंत में, मैं कुछ ऐसे SO उपयोगकर्ताओं को धन्यवाद देना चाहता हूं जिन्होंने बहुभुज से संबंधित महान प्रश्न पूछे। मैं उनके बिना इस जवाब के साथ नहीं आ सकता था।

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