R/AddHeatMap.R

In Blitzy29/R.Maps: Useful tools for my maps

# You can learn more about package authoring with RStudio at:
#
#   http://r-pkgs.had.co.nz/
#
# Some useful keyboard shortcuts for package authoring:
#
#   Build and Reload Package:  'Ctrl + Shift + B'
#   Check Package:             'Ctrl + Shift + E'
#   Test Package:              'Ctrl + Shift + T'

AddHeatMap <- function(map,dataHeatMap,bandwidth=NULL) {

  if (is.null(bandwidth)) {
    bandwidthLongitude <- (dataHeatMap[,max(abs(longitude))] - dataHeatMap[,min(abs(longitude))])/50
    bandwidthLatitude <- (dataHeatMap[,max(abs(latitude))] - dataHeatMap[,min(abs(latitude))])/50
    bandwidth <- c(bandwidthLongitude,bandwidthLatitude)
  }

  ## MAKE CONTOUR LINES
  ## Note, bandwidth choice is based on MASS::bandwidth.nrd()
  kde <- bkde2D(dataHeatMap[,list(longitude,latitude)],
                bandwidth=bandwidth)

  CL <- contourLines(kde$x1 , kde$x2 , kde$fhat)

  ## EXTRACT CONTOUR LINE LEVELS
  LEVS <- as.factor(sapply(CL, `[[`, "level"))
  NLEV <- length(levels(LEVS))

  ## CONVERT CONTOUR LINES TO POLYGONS
  pgons <- lapply(1:length(CL), function(i)
    Polygons(list(Polygon(cbind(CL[[i]]$x, CL[[i]]$y))), ID=i))
  spgons = SpatialPolygons(pgons)
  spgonsdf = SpatialPolygonsDataFrame(Sr = spgons,
                                      data = data.frame(level = LEVS),
                                      match.ID = TRUE)

  map %<>% addPolygons(data = spgonsdf,
                       color = heat.colors(NLEV, NULL)[spgonsdf@data$level])

  return(map)

}