Adding a scale bar and north arrow to a ggplot

On Wed, 15 Dec 2010, Paul Hiemstra wrote:

Hi people,

I posted a similar question to the ggplot2 mailing list and with 
their help and a lot of tinkering I got a well working function to 
add a scalebar to a ggplot plot. I could add the function to automap, 
but is there another package which would be more appropraite, e.g. sp 
(Roger?)?

Paul,

If it was added to sp, sp would depend on ggplot2 and its 
dependencies, which are quite extensive, and include a circularity, 
because ggplot2 suggests maptools, which in turn depends on sp. 
Consequently, sp is not a good idea. It might even make sense to split 
sp into sp with just classes and methods, and spViz for vizualisation 
methods, but changing things now is a bit late!

It will be cleaner to try to establish the mapping functionality that 
uses ggplot2 and sp as a separate package. Maybe Hadley would see this 
as a sensible development. 

There are already two supplements to ggplot2 on R-forge, but both 
moribund, I think, which suggests that this needs thinking through.

Roger

cheers,
Paul

ps: new version of code here:

makeNiceNumber = function(num, num.pretty = 1) {
 # Rounding provided by code from Maarten Plieger
 return((round(num/10^(round(log10(num))-1))*(10^(round(log10(num))-1)))) 

}

createBoxPolygon = function(llcorner, width, height) {
 relativeCoords = data.frame(c(0, 0, width, width, 0), c(0, height, 
height, 0, 0))
 names(relativeCoords) = names(llcorner)
 return(t(apply(relativeCoords, 1, function(x) llcorner + x)))
}

addScaleBar = function(ggplot_obj, spatial_obj, attribute, addParams 
= list()) {
 addParamsDefaults = list(noBins = 5, xname = "x", yname = "y", unit 
= "m", placement = "bottomright",
                          sbLengthPct = 0.3, sbHeightvsWidth = 1/14)
 addParams = modifyList(addParamsDefaults, addParams)

 range_x = max(spatial_obj[[addParams[["xname"]]]]) - 
min(spatial_obj[[addParams[["xname"]]]])
 range_y = max(spatial_obj[[addParams[["yname"]]]]) - 
min(spatial_obj[[addParams[["yname"]]]])
 lengthScalebar = addParams[["sbLengthPct"]] * range_x
 ## OPTION: use pretty() instead
 widthBin = makeNiceNumber(lengthScalebar / addParams[["noBins"]])
 heightBin = lengthScalebar * addParams[["sbHeightvsWidth"]]
 lowerLeftCornerScaleBar = c(x = 
max(spatial_obj[[addParams[["xname"]]]]) - (widthBin * 
addParams[["noBins"]]),
                             y = 
min(spatial_obj[[addParams[["yname"]]]]))

 scaleBarPolygon = do.call("rbind", lapply(0:(addParams[["noBins"]] - 
1), function(n) {
   dum = data.frame(createBoxPolygon(lowerLeftCornerScaleBar + c((n * 
widthBin), 0), widthBin, heightBin))
   if(!(n + 1) %% 2 == 0) dum$cat = "odd" else dum$cat = "even"
   return(dum)
 }))
 scaleBarPolygon[[attribute]] = min(spatial_obj[[attribute]])
 textScaleBar = data.frame(x = 
lowerLeftCornerScaleBar[[addParams[["xname"]]]] + 
(c(0:(addParams[["noBins"]])) * widthBin),
                           y = 
lowerLeftCornerScaleBar[[addParams[["yname"]]]],
                           label = 
as.character(0:(addParams[["noBins"]]) * widthBin))
 textScaleBar[[attribute]] = min(spatial_obj[[attribute]])

 return(ggplot_obj +
   geom_polygon(data = subset(scaleBarPolygon, cat == "odd"), fill = 
"black", color = "black", legend = FALSE) +
   geom_polygon(data = subset(scaleBarPolygon, cat == "even"), fill = 
"white", color = "black", legend = FALSE) +
   geom_text(aes(label = label), color = "black", size = 6, data = 
textScaleBar, hjust = 0.5, vjust = 1.2, legend = FALSE))
}

library(ggplot2)
library(sp)

data(meuse)
data(meuse.grid)
ggobj = ggplot(aes(x = x, y = y, color = zinc), data = meuse) + 
geom_point()
# Make sure to increase the graphic device a bit
addScaleBar(ggobj, meuse, "zinc", addParams = list(noBins = 5))


On 11/18/2010 09:12 PM, Paul Hiemstra wrote:

Dear list,

A common addition to any spatial plot are a north arrow and a scale 
bar. I've searched online for a straightforward way to add those to 
a ggplot plot. I then decided to give a go myself. A crude first 
attempt for an automatic scalebar addition function is listed below. 
The example works for the meuse dataset, but a second with a 
different dataset did yield good results.

My question to you is: is there anyone who has some good tips / 
example code to add a north arrow and a scalebar to a ggplot image. 
Any expansions on the code below are also welcome.

cheers,
Paul

ps Some info on my system is listed at the very bottom

library(sp)
library(ggplot2)

data(meuse)
data(meuse.grid)

string.length = function(s) {
#  browser()
  if(!is.character(s)) s = as.character(s)
  length(strsplit(s, "")[[1]])
}

makeNiceNumber = function(num, num.pretty = 1) {
  noNumbers = string.length(as.character(round(num)))
  return(round(num / 10^(noNumbers - num.pretty)) * 10^(noNumbers - 
num.pretty))
}

makeScaleBar = function(obj, plotname, xname = "x", yname = "y", 
unit = "m", placement = "bottomright") {
#     browser()
  range_x = max(obj[[xname]]) - min(obj[[xname]])
  range_y = max(obj[[yname]]) - min(obj[[yname]])
  if(placement == "bottomright") {
    xcoor.max = makeNiceNumber(max(obj[[xname]]) - (0.05 *range_x ), 
string.length(round(max(obj[[xname]]))) - string.length(round(0.3 * 
range_x)))
    xcoor.min = makeNiceNumber(max(obj[[xname]]) - (0.5 *range_x ), 
string.length(round(max(obj[[xname]]))) - string.length(round(0.3 * 
range_x)))
    ycoor = min(obj[[yname]]) + (0.05 * range_y)
  } else {
    xcoor.min = makeNiceNumber(max(obj[[xname]]) - (0.95 *range_x ), 
string.length(round(max(obj[[xname]]))) - string.length(round(0.3 * 
range_x)))
    xcoor.max = makeNiceNumber(max(obj[[xname]]) - (0.5 *range_x ), 
string.length(round(max(obj[[xname]]))) - string.length(round(0.3 * 
range_x)))
    ycoor = min(obj[[yname]]) + (0.95 * range_y)
  }
  scalebar.data = data.frame(x = c(xcoor.max, xcoor.min), y = ycoor, 
lbl = c(paste(xcoor.max - xcoor.min, unit), 0))
  scalebar.data[[plotname]] = min(obj[[plotname]])
  return(list(geom_path(aes(x = x, y = y), data = scalebar.data, lwd 
= 2, color = "black"),
          geom_text(aes(x = x, y = y, label = lbl), data = 
scalebar.data, vjust = 1.3)))
}

sb = makeScaleBar(meuse.grid, "dist", placement = "topright")
ggplot(aes(x  = x, y = y, fill = dist), data = meuse.grid) + 
geom_tile() + sb[[1]] + sb[[2]]

R version 2.12.0 (2010-10-15)
Platform: i486-pc-linux-gnu (32-bit)

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C
 [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8
 [5] LC_MONETARY=C              LC_MESSAGES=en_US.UTF-8
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C
 [9] LC_ADDRESS=C               LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods
[8] base

other attached packages:
[1] ggplot2_0.8.7 digest_0.4.2  reshape_0.8.3 plyr_0.1.9    proto_0.3-8
[6] sp_0.9-62

loaded via a namespace (and not attached):
[1] lattice_0.19-13

hiemstra at fg-113:~$ uname -a
Linux fg-113 2.6.32-21-generic #32-Ubuntu SMP Fri Apr 16 08:10:02 
UTC 2010 i686 GNU/Linux