Considereing the number of the coordinate in the heatmap

Question

I'm trying to make a heatmap considering the value of the point (variable 'x'). But when I run my code I only have the heatmap considering the points, and not its values.

Here is my code:

head(dengue)

 lat     long    x
1 7791000 598157.0  156
2 7790677 598520.0  307
3 7790795 598520.0  153
4 7790153 598808.0  135
5 7790935 598813.0 1888
6 7790765 598881.7 1169

library(ggplot2)
library(ggsn)

hmap <- ggplot(dengue, aes(x=long, y=lat)) + 
          stat_density2d(aes(fill = ..level..), alpha=0.8, geom="polygon") +
          geom_point(colour="red") +
          geom_path(data=map.df,aes(x=long, y=lat,group=group), colour="grey50") +
          scale_fill_gradientn(colours=rev(brewer.pal(5,"Spectral"))) +
          coord_fixed() + 
          scalebar(location="bottomright",y.min=7781600.0, y.max=7812898.0, 
                                          x.min=597998.4, x.max=619721.2, 
                                          dist=2,  transform = F,                    
                                          st.dist=.04,dist_unit="km") + 
         blank() + 
         guides(fill=guide_legend(title=""))

north2(hmap, x=.7, y=.9, symbol=16)

And here is the map that I got:

Any hint on how can I make a heatmap considering the values of the points (variable 'x'), and not just its coordinates?

Answer 1

There was a post here that describes the adaptation of the MASS package's kde2d function to take into account the weights of points.

library(MASS)

kde2d.weighted <- function (x, y, w, h, n = 25, lims = c(range(x), range(y))) {
  nx <- length(x)
  if (length(y) != nx) 
    stop("data vectors must be the same length")
  gx <- seq(lims[1], lims[2], length = n) # gridpoints x
  gy <- seq(lims[3], lims[4], length = n) # gridpoints y
  if (missing(h)) 
    h <- c(bandwidth.nrd(x), bandwidth.nrd(y));
  if (missing(w)) 
    w <- numeric(nx)+1;
  h <- h/4
  ax <- outer(gx, x, "-")/h[1] # distance of each point to each grid point in x-direction
  ay <- outer(gy, y, "-")/h[2] # distance of each point to each grid point in y-direction
  z <- (matrix(rep(w,n), nrow=n, ncol=nx, byrow=TRUE)*matrix(dnorm(ax), n, nx)) %*% t(matrix(dnorm(ay), n, nx))/(sum(w) * h[1] * h[2]) # z is the density
  return(list(x = gx, y = gy, z = z))
}

This is not natively embedded in ggplot2 as far as I'm aware, but you could preprocess your data outside ggplot to get the data you can put into stat_contour:

# Reading in your example data
zz <- " lat     long    x
1 7791000 598157.0  156
2 7790677 598520.0  307
3 7790795 598520.0  153
4 7790153 598808.0  135
5 7790935 598813.0 1888
6 7790765 598881.7 1169"
df <- read.table(text = zz)

# Doing the weighted 2d kde
wdf <- kde2d.weighted(df$lat, df$long, df$x)
wdf <- data.frame(lat = wdf$x[row(wdf$z)],
                  long = wdf$y[col(wdf$z)],
                  value = wdf$z[T])


# Plotting the result:
ggplot(df, aes(lat, long)) +
  stat_contour(data = wdf, aes(z =  value, fill = stat(level)), geom = "polygon") +
  geom_text(aes(label = x)) # to show the weights

As you can see, the contours are a bit cut off at ugly points, but I suppose this could be amended by playing around with the lims argument of the kde2d.weighted().