Generating spatial heat map via ggmap in R based o

问题:

I'd like to generate a choropleth map using the following data points:

• Longitude
• Latitude
• Price

Here is the dataset - https://www.dropbox.com/s/0s05cl34bko7ggm/sample_data.csv?dl=0.

I would like the map to show the areas where the price is higher and the where price is lower. It should most probably look like this (sample image):

Here is my code:

library(ggmap)

map <- get_map(location = "austin", zoom = 9)
data <- read.csv(file.choose(), stringsAsFactors = FALSE)
data$average_rate_per_night <- as.numeric(gsub("[\\$,]", "", 
data$average_rate_per_night))
ggmap(map, extent = "device") + 
stat_contour( data = data, geom="polygon", 
            aes( x = longitude, y = latitude, z = average_rate_per_night, 
fill = ..level.. ) ) +
scale_fill_continuous( name = "Price", low = "yellow", high = "red" )

I'm getting the following error message:

2: Computation failed in `stat_contour()`:
Contour requires single `z` at each combination of `x` and `y`. 

I'd really appreciate any help on how this can be fixed or any other method to generate this type of heatmap. Please note that I'm interested in the weight of the price, not density of the records.

回答1:

If you insist on using the contour approach then you need to provide a value for every possible x,y coordinate combination you have in your data. To achieve this I would highly recommend to grid the space and generate some summary statistics per bin.

I attach a working example below based on the data you provided:

library(ggmap)
library(data.table)

map <- get_map(location = "austin", zoom = 12)
data <- setDT(read.csv(file.choose(), stringsAsFactors = FALSE))

# convert the rate from string into numbers
data[, average_rate_per_night := as.numeric(gsub(",", "", 
       substr(average_rate_per_night, 2, nchar(average_rate_per_night))))]

# generate bins for the x, y coordinates
xbreaks <- seq(floor(min(data$latitude)), ceiling(max(data$latitude)), by = 0.01)
ybreaks <- seq(floor(min(data$longitude)), ceiling(max(data$longitude)), by = 0.01)

# allocate the data points into the bins
data$latbin <- xbreaks[cut(data$latitude, breaks = xbreaks, labels=F)]
data$longbin <- ybreaks[cut(data$longitude, breaks = ybreaks, labels=F)]

# Summarise the data for each bin
datamat <- data[, list(average_rate_per_night = mean(average_rate_per_night)), 
                 by = c("latbin", "longbin")]

# Merge the summarised data with all possible x, y coordinate combinations to get 
# a value for every bin
datamat <- merge(setDT(expand.grid(latbin = xbreaks, longbin = ybreaks)), datamat, 
                 by = c("latbin", "longbin"), all.x = TRUE, all.y = FALSE)

# Fill up the empty bins 0 to smooth the contour plot
datamat[is.na(average_rate_per_night), ]$average_rate_per_night <- 0

# Plot the contours
ggmap(map, extent = "device") +
  stat_contour(data = datamat, aes(x = longbin, y = latbin, z = average_rate_per_night, 
               fill = ..level.., alpha = ..level..), geom = 'polygon', binwidth = 100) +
  scale_fill_gradient(name = "Price", low = "green", high = "red") +
  guides(alpha = FALSE)

You can then play around with the bin size and the contour binwidth to get the desired result but you could additionally apply a smoothing function on the grid to get an even smoother contour plot.

回答2:

You could use the stat_summary_2d() or stat_summary_hex() function to achieve a similar result. These functions divide the data into bins (defined by x and y), and then the z values for each bin are summarised based on a given function. In the example below I have selected mean as an aggregation function and the map basically shows the average price in each bin.

Note: I needed to treat your average_rate_per_night variable appropriately in order to convert it into numbers (removed the $ sign and the comma).

library(ggmap)
library(data.table)

map <- get_map(location = "austin", zoom = 12)
data <- setDT(read.csv(file.choose(), stringsAsFactors = FALSE))
data[, average_rate_per_night := as.numeric(gsub(",", "",
    substr(average_rate_per_night, 2, nchar(average_rate_per_night))))]

ggmap(map, extent = "device") +
    stat_summary_2d(data = data, aes(x = longitude, y = latitude, 
        z = average_rate_per_night), fun = mean, alpha = 0.6, bins = 30) +
    scale_fill_gradient(name = "Price", low = "green", high = "red")