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

Paul Hiemstra p.hiemstra at geo.uu.nl
Thu Dec 16 09:21:49 CET 2010


Hi Hadley,

That would great if rasters could be printed more efficiently. Could you 
send me an e-mail, or post on the r-sig-geo list when you are ready to 
receive any contributed code?

Paul

On 12/15/2010 10:20 PM, Hadley Wickham wrote:
> This is something that I hope the student would explore over summer.
>
> Hadley
>
> On Wed, Dec 15, 2010 at 2:27 PM, Pierre Roudier
> <pierre.roudier at gmail.com>  wrote:
>    
>> I'd love to see a separate, dedicated package bringing spatial
>> functionalities to ggplot2 - this is such a great tool. However, it
>> seems to me that a significant problem when using ggplot2 is the lack
>> of geom dedicated to raster data.
>>
>> My experience is you can't really deal with big rasters using
>> geom_tile, it takes too much memory. I guess the development of a
>> geom_raster is necessary to fully mimic spplot() functionalities - no
>> idea how demanding an effort would that be.
>>
>> Pierre
>>
>> 2010/12/15 Roger Bivand<Roger.Bivand at nhh.no>:
>>      
>>> 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
>>>
>>> _______________________________________________
>>> R-sig-Geo mailing list
>>> R-sig-Geo at r-project.org
>>> https://stat.ethz.ch/mailman/listinfo/r-sig-geo
>>>
>>>        
>> _______________________________________________
>> R-sig-Geo mailing list
>> R-sig-Geo at r-project.org
>> https://stat.ethz.ch/mailman/listinfo/r-sig-geo
>>
>>      
>
>
>    


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