[R-sig-Geo] Adding a scale bar and north arrow to a ggplot

Edzer Pebesma edzer.pebesma at uni-muenster.de
Wed Dec 15 17:58:04 CET 2010


I think both packages have good reasons to not want to depend on
eachother, as integrating this in one of them would imply. Your solution
seems a reasonable one to me.

On 12/15/2010 02:07 PM, Hadley Wickham wrote:
> I have a student who is interested in working on more spatial features
> for ggplot2 this summer. That work is likely to involve separating out
> all spatial features from ggplot2 into their own package and that
> would be a good place for this.
> 
> Hadley
> 
> On Wednesday, December 15, 2010, Paul Hiemstra <p.hiemstra at geo.uu.nl> 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?)?
>>
>> 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
>>
>>
>>
>>
>> --
>> Paul Hiemstra, MSc
>> Department of Physical Geography
>> Faculty of Geosciences
>> University of Utrecht
>> Heidelberglaan 2
>> P.O. Box 80.115
>> 3508 TC Utrecht
>> Phone:  +3130 253 5773
>> http://intamap.geo.uu.nl/~paul
>> http://nl.linkedin.com/pub/paul-hiemstra/20/30b/770
>>
>> currently @ KNMI
>> paul.hiemstra_AT_knmi.nl
>>
>> _______________________________________________
>> R-sig-Geo mailing list
>> R-sig-Geo at r-project.org
>> https://stat.ethz.ch/mailman/listinfo/r-sig-geo
>>
> 

-- 
Edzer Pebesma
Institute for Geoinformatics (ifgi), University of Münster
Weseler Straße 253, 48151 Münster, Germany. Phone: +49 251
8333081, Fax: +49 251 8339763  http://ifgi.uni-muenster.de
http://www.52north.org/geostatistics      e.pebesma at wwu.de



More information about the R-sig-Geo mailing list