R/vcmap.R

In vdmR: Visual Data Mining Tools

#' Generate choropleth map with interactive functions
#'
#' \code{vcmap} generates choropleth map with interactive functions.
#'
#' @docType methods
#' @param shapefile path to ESRI shapefile to draw choropleth map
#' @param data data frame for default data set
#' @param mid unique id in the attribute table of the shape file for linking the data frame \code{data}
#' @param did unique id in the data frame \code{data} for linking the attribute table of the shape file
#' @param name character for the name of the generated scatter plot
#' @param tag character for the common name of a series of linked plots
#' @param path character string of a directory for writing HTML and SVG files
#' @param fill column name assigned to the color of polygons
#' @param ggscale color scale generated by scale_fill_* function
#' @importFrom grDevices dev.off pdf
#' @importFrom utils packageVersion
#' @export
#' @examples
#' data(vsfuk2012)
#' shp.path <- file.path(system.file(package="vdmR"), "etc/shapes/kitakyu2012.shp")
#' kk2012 <- dplyr::filter(vsfuk2012, CityCode<40110&CityCode>40100)
#' vcmap(shp.path, kk2012, "CityCode", "CityCode", "map1", "kk2012")
#' vlaunch(kk2012, "main", "kk2012", browse=FALSE)
#'

vcmap <- function(shapefile, data, mid, did, name, tag, path = tempdir(), fill=NULL, ggscale=NULL){

  jspath <- file.path(system.file(package="vdmR"), "exec/vdmr_cmap.js")
  file.copy(jspath, paste0(path, "/", name, ".", tag, ".js"), overwrite=TRUE)

  spdf <- rgdal::readOGR(shapefile)

  data$no <- 1:nrow(data)

  map <- broom::tidy(spdf, region=mid)
  map <- sp::merge(map, data, by.x="id", by.y=did)

  map <- dplyr::arrange(map, map[["no"]], map[["group"]], map[["order"]])

  mapid <- unique(map$id)

  mdmapping <- sp::merge(data.frame(x=mapid, mapid=1:length(mapid)),
                     data.frame(x=data[did], did=1:nrow(data)), by.x="x", by.y=did, all=TRUE)

  mtod <- mdmapping$did
  names(mtod) <- mdmapping$mapid
  mtod <- mtod[!is.na(mdmapping$mapid)]

  dtom <- mdmapping$mapid
  names(dtom) <- mdmapping$did
  dtom <- dtom[!is.na(mdmapping$did)]

  pdf(file=NULL, width=7, height=5)

  eval(substitute(
    p <- ggplot2::ggplot(map, ggplot2::aes(long, lat, group=group, fill=fill0)),
    list(fill0=substitute(fill))
  ))

  for(code in mapid){
    if(packageVersion("ggplot2")>'1.0.1'){
      p <- p + ggplot2::layer(geom="polygon", data=map[map$id==code,],
                              stat="identity", position="identity",
                              params=list(na.rm=TRUE))
    } else {
      p <- p + ggplot2::layer(geom="polygon", data=map[map$id==code,])
    }
  }
  p <- p + ggplot2::coord_fixed()

  p <- p + ggscale

  mapgrob <- ggplot2::ggplotGrob(p)
  grid::grid.newpage()
  grid::grid.draw(mapgrob)
  
  grid::grid.force()
  
  if(packageVersion("ggplot2")>'1.0.1'){
    grid::grid.gedit("geom_polygon.polygon", name="GRID.polygon")
  } else {
    grid::grid.gedit("geom_polygon.gTree", name="geom_polygon.gTree")
    grid::grid.gedit("GRID.polygon", name="GRID.polygon")
  }

  gridSVG::grid.script(paste("var polnum = ",rjson::toJSON(1:length(mapid)),";",sep=""))
  gridSVG::grid.script(file=paste(name, ".", tag,".js", sep=""))
  gridSVG::grid.script(paste("var winname= '", name, "';", sep=""))
  gridSVG::grid.script(paste("var dtom = ", rjson::toJSON(dtom), ";", sep=""))
  gridSVG::grid.script(paste("var mtod = ", rjson::toJSON(mtod), ";", sep=""))

  svgfn <- paste0(path, "/", name, ".", tag, ".svg")
  gridSVG::grid.export(svgfn, htmlWrapper=FALSE, exportMappings="file",
                       xmldecl="<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n")
  htmlWrapper(path, paste0(name, ".", tag, ".svg"))

  invisible(dev.off())

}