[R-sig-Geo] Adding a scale bar and north arrow to a ggplot
Hadley Wickham
hadley at rice.edu
Wed Dec 15 14:07:29 CET 2010
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
>
--
Assistant Professor / Dobelman Family Junior Chair
Department of Statistics / Rice University
http://had.co.nz/
More information about the R-sig-Geo
mailing list