Maps with R – part III shows how to make an active svg-map from R. In that example, a specialiced data set was used. I have redone it by using a map pulled in from postgis and also added on some more functionallity, some of it may be extened further to make a kind of client-based web-gis application. This examnple map uses a continous color scale for a map of discrete values. This is a bad idea, but is used here to simplify the example.
Moving the mouse pointer over the map shows a tooltip with some selected information for each polygon. When clicking on a polygon, the color changes and a callback to the web pages makes the web page show the ID of the polygon. This can of cource be used to show more information, possibly fetched through an ajax call.
The svg-map is prepared through R. A number of pakages must be loaded:
library(gridSVG)
library(sp)
library(lattice)
library(latticeExtra)
library(maptools)
library(colorspace)
I have a variable called “map” that is a map pulled in from a postgres database.
map=readOGR("PG:dbname=database user=username password=password",layer=<name of the table in postgis>)
Some parts must be prepared before the svg-export can be run:
grid.newpage()
set_Polypath(FALSE)
panel.str < - deparse(panel.polygonsplot, width=500)
panel.str <- sub("grid.polygon\\((.*)\\)","grid.polygon(\\1, name=paste('ID', slot(map, 'data'\\)\\$gid\\[i\\], sep=':'))", panel.str)
panel.polygonNames <- eval(parse(text=panel.str),envir=environment(panel.polygonsplot))
p <- spplot(map["category"], panel=panel.polygonNames)
eval(p)
set_Polypath(TRUE)
For other use, two lines must/ may be altered:
panel.str < - sub("grid.polygon\\((.*)\\)","grid.polygon(\\1, name=paste('ID', slot(map, 'data'\\)\\ $gid\\[i\\], sep=':'))", panel.str)
map is the name of the variable in which the map is stored.
gid is the name of the polygon id.
This lines makes an ID of each polygon that is made as "ID:" and the value of gid for each polygon.
p < - spplot(map["category"], panel=panel.polygonNames)
Again, map is the variable holding the map, category is the variable I want to be used for coloring the map.
Thereafter, the graphical objects (grobs) that we want to work on has to be enumerated:
## grobs in the graphical output
grobs < - grid.ls()
## only interested in those with "ID:" in the name
nms <- grobs$name[grobs$type == "grobListing"]
idxNames <- grep('ID:', nms)
IDs <- nms[idxNames]
for (id in unique(IDs)){
# Need to get back the gid-value
x < - unlist(strsplit(id, 'ID:'))
i=as.numeric(x[2])
# Looks up the map element with the corresponding gid
n=which(map$gid==i)
# Picks out values of category and shape_area for making the tooltip
info=paste(id,"->",map$category[n],'(',map$shape_area[n],'m2 )')
g < - grid.get(id)
## attach SVG attributes
# Defines attributes for the respective polygons. the javascript functions is defined in "tooltips.js" (see below)
grid.garnish(id,
onmouseover=paste("showTooltip(evt, '",info,"')"),
onmouseout="hideTooltip()",
onclick="mark(evt)",
class=paste('cc',map$categorycode[n],sep=''),
name=info)
}
# The file containing the javascript functions
grid.script(filename="tooltip.js")
svgname="svgtest.svg"
gridToSVG(svgname)
This will produce the svg-file svgtest.svg and a very simple (too simple) html-file, svgtest.svg.html. The file tooltip.js must be available in the same directry as the svg.
The function mark(evt) is calling
parent.showalert(txt);
The parent object is the webpage that contains the svg-file, so the showalert(txt) function must be defined in that page. In this case, it is as simple as function showalert(txt){
document.getElementById('Showinfo').innerHTML=txt;
}
The page is available at http://sickel.net/misc/Geilo_annomap.svg.html
Possible further development:
* Click on an item in the legend to get all items of that class marked (they are already set to the same class)
* Fetch more information from a backend server when clicking (or for the tooltip)
* Change the color coding of the map (eg by fetching information from the backend
If this is to be run under R v 2.x, (e.g. on an older Ubuntu LTS) the available packages is lacking two functions, they may be provided through the following stubs:
grobDescent< -function(x=0,y=0,z=0){
return(unit(1,"npc"))
}
grobAscent<-function(x=0,y=0,z=0){
return(unit(1,"npc"))
}