Adding a scale bar and north arrow to a ggplot

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?)?

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