[R-sig-Geo] Adding a scale bar and north arrow to a ggplot
Paul Hiemstra
p.hiemstra at geo.uu.nl
Wed Dec 15 08:58:57 CET 2010
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
More information about the R-sig-Geo
mailing list