[R-sig-Geo] Adding a scale bar and north arrow to a ggplot
Roger Bivand
Roger.Bivand at nhh.no
Wed Dec 15 09:53:38 CET 2010
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
>>
>
>
>
--
Roger Bivand
Economic Geography Section, Department of Economics, Norwegian School of
Economics and Business Administration, Helleveien 30, N-5045 Bergen,
Norway. voice: +47 55 95 93 55; fax +47 55 95 95 43
e-mail: Roger.Bivand at nhh.no
More information about the R-sig-Geo
mailing list