Category Archives: Tutorials

Würzburg map code

library(sp)
library(RColorBrewer)
library(raster)
library(rgdal)
library(OpenStreetMap)
library(latticeExtra)
library(plyr)
library(colorspace)
library(gridExtra)
library(scales)

# library(munsell)
# library(dichromat)
# library(labeling)

library(Rtography)
# library(devtools)
# install_github(‘Rtography’, ‘tim-salabim’)
# library(Rtography)

# rasterOptions(tmpdir = “/media/HDEXTENSION/”)
### set global options
map.zoom <- 12
map.type = ‘bing’ #’opencyclemap’ #
#launchMapHelper()
### read plot data
#plots <- read.csv(‘/media/windows/tappelhans/uni/marburg/kili/plots/kili_plots_64.csv’)
plots <- read.csv(‘C:/tappelhans/uni/marburg/kili/plots/kili_plots_64.csv’)

#plots <- subset(plots, Categories == “Helichrysum”)
#plots <- droplevels(plots)

coordinates(plots) <- ~ Easting + Northing
proj4string(plots) <- CRS(“+proj=utm +ellps=clrk80 +zone=37 +units=m +south”)

plots.ll <- spTransform(plots, CRS(“+proj=longlat”))
### define extent of map based on points and download
#bbPoints <- bbox(plots.ll)
xmin <- bbox(plots.ll)[1, 1] – 0.2
ymin <- bbox(plots.ll)[2, 1] – 0.2
xmax <- bbox(plots.ll)[1, 2] + 0.2
ymax <- bbox(plots.ll)[2, 2] + 0.2

ul <- c(ymax, xmin)
lr <- c(ymin, xmax)

omap.merc <- openmap(ul, lr, type = map.type, zoom = map.zoom)

# plot(omap.merc)

omap.utm <- openproj(omap.merc,
“+proj=utm +ellps=clrk80 +zone=37 +units=m +south”)
### use downloaded map for sp raster layout definition
omap_cols <- matrix(omap.utm$tiles[[1]]$colorData,
nrow = omap.utm$tiles[[1]]$xres,
ncol = omap.utm$tiles[[1]]$yres)
attr(omap_cols, “class”) <- c(“ggmap”, “raster”)
attr(omap_cols, “bb”) <- data.frame(ll.lat = omap.utm$tiles[[1]]$bbox$p2[2],
ll.lon = omap.utm$tiles[[1]]$bbox$p1[1],
ur.lat = omap.utm$tiles[[1]]$bbox$p1[2],
ur.lon = omap.utm$tiles[[1]]$bbox$p2[1])

bbMap <- attr(omap_cols, ‘bb’)
latCenter <- with(bbMap, ll.lat + ur.lat)/2
lonCenter <- with(bbMap, ll.lon + ur.lon)/2
height <- with(bbMap, ur.lat – ll.lat)
width <- with(bbMap, ur.lon – ll.lon)

## Use sp.layout of spplot: a list with the function and its
## arguments
sp.raster <- list(‘grid.raster’, omap_cols,
x=lonCenter, y=latCenter,
width=width, height=height,
default.units=’native’)
### define colours for study plot locations
n <- length(unique(plots$Categories))

clrs.hcl <- function(n) {
hcl(h = seq(0, 270, length.out = n),
c = 60, l = 50, fixup = TRUE)
}

 

### create spplot object and Rtographize
pts <- spplot(plots["Categories"], col.regions = clrs.hcl(n),
sp.layout = list(sp.raster))

pts <- Rtographize(pts)
### add map objects using viewports
#png(“KiLi_plots_hel.png”, width = 1024 * 3, height = 768 * 3, res = 300)
grid.newpage()
print(pts)

downViewport(trellis.vpname(name = “figure”))
vp1 <- viewport(x = unit(0.99, “npc”), y = unit(0.01, “npc”),
width = 0.25, height = 0.1, just = c(“right”, “bottom”),
name = “inset_scalebar”, gp = gpar(cex = 0.5))

pushViewport(vp1)
#grid.rect(gp = gpar(fill = “transparent”, col = “transparent”))
gridScaleBar(pts, addParams = list(noBins = 4, scale.fact = 1.5,
vpwidth = as.numeric(vp1$width)))
upViewport(1)

vp2 <- viewport(x = unit(0.01, “npc”), y = unit(0.01, “npc”),
width = 0.05, height = 0.15, just = c(“left”, “bottom”),
name = “inset_northarrow”, gp = gpar(cex = 0.8))

pushViewport(vp2)
gridNorthArrow()
upViewport(1)

vp3 <- viewport(x = unit(0.98, “npc”), y = unit(0.98, “npc”),
width = 0.2, height = 0.025 * n,
just = c(“right”, “top”),
name = “inset_legend”)

pushViewport(vp3)
gridMapLegend(labs = plots$Categories, clrs = clrs.hcl(n),
type = “circles”)
upViewport(0)

#dev.off()