Merge branch 'bloomfield' into 'master'

Add bloomfield figure

See merge request WEEL_grp/study-area-figures!4

R/00-palette.R

@@ -1,12 +1,20 @@
 ### Palette - Study area figure ====
 # Alec Robitaille
 
+# Water
 watercol <- '#c3e2ec'
+streamcol <- '#7e9da7'
+streampolcol <- '#9cb4bc'
+coastcol <- '#b59f78'
+
+# Land
 islandcol <- '#d0c2a9'
-coastcol <- '#82796a'
+
+# Anthro
 roadcol <- '#666666'
-gridcol <- '#323232'
 
-parkcol <- '#9fb5a0'
-parkboundcol <- '#4c5d3a'
+parkcol <- '#b4bc9c'
+parkboundcol <- '#90967c'
 
+# Map etc
+gridcol <- '#323232'

R/06-terra-nova-prep.R

@@ -11,7 +11,7 @@ lapply(libs, require, character.only = TRUE)
 ## Polygon from Open Canada
 # https://open.canada.ca/data/en/dataset/e1f0c975-f40c-4313-9be2-beb951e35f4e
 curl_download('http://ftp.maps.canada.ca/pub/pc_pc/National-parks_Parc-national/national_parks_boundaries/national_parks_boundaries.shp.zip', 'input/national-parks.zip')
-
+dir.create('input')
 unzip('input/national-parks.zip', exdir = 'input/national-parks')
 
 parks <- st_read('input/national-parks')
@@ -21,7 +21,7 @@ tn <- parks[parks$parkname_e == 'Terra Nova National Park of Canada', ]
 
 ## Roads
 # Need latlon
-bb <- st_bbox(st_transform(st_buffer(tn, 1e4), 4326))
+bb <- st_bbox(st_transform(st_buffer(tn, 5e4), 4326))
 routes <- opq(bb) %>%
 	add_osm_feature(key = 'highway') %>%
 	osmdata_sf()
@@ -41,6 +41,14 @@ mpols <- water$osm_multipolygons
 waterpols <- st_union(st_combine(mpols))
 
 
+# Streams
+waterways <- opq(bb) %>%
+	add_osm_feature(key = 'waterway') %>%
+	osmdata_sf()
+
+streamsPol <- st_cast(st_polygonize(st_union(waterways$osm_lines)))
+streamsLns <- waterways$osm_lines
+
 ### Reproject ----
 # Projection
 utm <- st_crs('+proj=utm +zone=21 ellps=WGS84')
@@ -49,8 +57,12 @@ utm <- st_crs('+proj=utm +zone=21 ellps=WGS84')
 utmTN <- st_transform(tn, utm)
 utmRoads <- st_transform(roads, utm)
 utmWater <- st_transform(waterpols, utm)
+utmStreamsLns <- st_transform(streamsLns, utm)
+utmStreamsPol <- st_transform(streamsPol, utm)
 
 ### Output ----
 st_write(utmTN, 'output/terra-nova-polygons.gpkg')
 st_write(utmRoads, 'output/terra-nova-roads.gpkg')
 st_write(utmWater, 'output/terra-nova-water.gpkg')
+st_write(utmStreamsLns, 'output/terra-nova-streams-lns.gpkg')
+st_write(utmStreamsPol, 'output/terra-nova-streams-pols.gpkg')

R/07-terra-nova-figure.R

@@ -18,6 +18,8 @@ roads <- st_read('output/terra-nova-roads.gpkg')
 nl <- st_read('output/newfoundland-polygons.gpkg')
 
 water <- st_read('output/terra-nova-water.gpkg')
+streamLns <- st_read('output/terra-nova-streams-lns.gpkg')
+streamPols <- st_read('output/terra-nova-streams-pols.gpkg')
 
 # CRS
 utm <- st_crs('+proj=utm +zone=21 ellps=WGS84')
@@ -56,6 +58,8 @@ nlcrop <- st_crop(nl, bb + rep(c(-5e4, 5e4), each = 2))
  	geom_sf(fill = islandcol, size = 0.3, color = coastcol, data = nlcrop) +
  	geom_sf(fill = parkcol, size = 0.3, color = parkboundcol, data = tn) +
  	geom_sf(fill = watercol, size = 0.2, color = coastcol, data = water) +
+ 	geom_sf(fill = streampolcol, color = NA, data = streamPols) +
+ 	geom_sf(color = streamcol, size = 0.4, data = streamLns) +
  	geom_sf(aes(color = highway), data = highway) +
  	geom_sf_label(aes(label = 'Terra Nova National Park'), size = 5, fontface = 'bold', data = tn) +
  	scale_color_manual(values = roadpal) +

R/08-terra-nova-buns-figure.R

@@ -40,6 +40,8 @@ roads <- st_read('output/terra-nova-roads.gpkg')
 nl <- st_read('output/newfoundland-polygons.gpkg')
 
 water <- st_read('output/terra-nova-water.gpkg')
+streamLns <- st_read('output/terra-nova-streams-lns.gpkg')
+streamPols <- st_read('output/terra-nova-streams-pols.gpkg')
 
 # CRS
 utm <- st_crs('+proj=utm +zone=21 ellps=WGS84')
@@ -100,8 +102,10 @@ nlcrop <- st_crop(nl, bbadjust + rep(c(-5e4, 5e4), each = 2))
 		geom_sf(fill = islandcol, size = 0.3, color = coastcol, data = nlcrop) +
 		geom_sf(fill = parkcol, size = 0.3, color = parkboundcol, data = tn) +
 		geom_sf(fill = watercol, size = 0.2, color = coastcol, data = water) +
-		geom_sf(aes(color = highway), data = highway) +
 		scale_color_manual(values = roadpal) +
+		geom_sf(color = streamcol, size = 0.4, data = streamLns) +
+		geom_sf(fill = streampolcol, color = streamcol, alpha = 0.5, color = NA, data = streamPols) +
+		geom_sf(aes(color = highway), data = highway) +
 		geom_point(aes(x, y), data = grids) +
 		geom_sf_label(aes(label = 'Terra Nova National Park'), data = tn, fill = '#bbcbbc') +
 		geom_label_repel(aes(x, y, label = SiteName), size = 4.5, data = grids) +

R/09-bloomfield-figure.R

@@ -0,0 +1,132 @@
+### Bloomfield Study Area Figure ====
+# Alec L. Robitaille, Juliana Balluffi-Fry
+
+
+### Packages ----
+libs <- c(
+	'data.table',
+	'ggplot2',
+	'sf',
+	'ggrepel'
+)
+lapply(libs, require, character.only = TRUE)
+
+
+### Data ----
+grids <- data.table(SiteName = 'Bloomfield',
+										x = 723457,
+										y = 5359856)
+
+roads <- st_read('output/terra-nova-roads.gpkg')
+nl <- st_read('output/newfoundland-polygons.gpkg')
+water <- st_read('output/terra-nova-water.gpkg')
+streamLns <- st_read('output/terra-nova-streams-lns.gpkg')
+streamPols <- st_read('output/terra-nova-streams-pols.gpkg')
+
+
+# CRS
+utm <- st_crs(nl)
+
+# Bounding Box
+# In meters
+dist <- 4e4
+zoomout <- rep(c(-dist, dist), each = 2)
+bb <- st_bbox(st_as_sf(grids, coords = c('x', 'y'))) + zoomout
+
+# Only main highway and primary
+selroads <- c('trunk', 'primary', 'secondary')
+roads <- roads[roads$highway %in% selroads,]
+
+
+# Zoomout x2 to ensure no data is clipped within view
+streams <- st_crop(streamLns, bb + (zoomout * 2))
+highway <- st_crop(roads, bb + (zoomout * 2))
+nlcrop <- st_crop(nl, bb + (zoomout * 2))
+
+
+
+
+### Theme ----
+# Colors
+source('R/00-palette.R')
+
+roadcols <- data.table(highway = c('trunk',  'trunk_link', 'primary', 'primary_link',
+																	 'secondary', 'secondary_link', 'tertiary',
+																	 'tertiary_link',
+																	 'service', 'residential', 'construction' ,
+																	 'unclassified', 'cycleway', 'footway', 'bridleway',
+																	 'path', 'track', 'steps'
+))
+roadcols[, cols := gray.colors(.N, start = 0.1, end = 0.6)]
+roadpal <- roadcols[, setNames(cols, highway)]
+
+
+# Theme
+themeMap <- theme(panel.border = element_rect(size = 1, fill = NA),
+									panel.background = element_rect(fill = watercol),
+									panel.grid = element_line(color = gridcol, size = 0.6),
+									axis.text = element_text(size = 11, color = 'black'),
+									axis.title = element_blank())
+
+### Plot ----
+
+# NL plot
+(gnl <- ggplot() +
+ 	geom_sf(fill = islandcol, size = 0.1, color = 'black', data = nl) +
+ 	geom_rect(
+ 		aes(
+ 			xmin = bb['xmin'],
+ 			xmax = bb['xmax'],
+ 			ymin = bb['ymin'],
+ 			ymax = bb['ymax']
+ 		),
+ 		fill = NA,
+ 		size = 1.5,
+ 		color = 'red'
+ 	) +
+ 	themeMap +
+ 	theme(axis.text = element_blank(),
+ 				axis.ticks = element_blank(),
+ 				plot.margin = grid::unit(c(-1,-1,-1,-1), 'mm')))
+
+
+# Base bloomfield
+(gblm <- ggplot() +
+ 	geom_sf(fill = islandcol, size = 0.3, color = coastcol, data = nlcrop) +
+	geom_sf(fill = watercol, size = 0.2, color = coastcol, data = water) +
+ 	geom_sf(fill = streampolcol, color = NA, data = streamPols) +
+	geom_sf(color = streamcol, size = 0.2, data = streamLns) +
+ 	geom_sf(aes(color = highway), size = 0.5, data = highway) +
+	geom_point(aes(x, y), size = 2, data = grids) +
+	geom_label_repel(aes(x, y, label = SiteName), size = 6.5, data = grids) +
+ 	scale_color_manual(values = roadpal) +
+	coord_sf(xlim = c(bb['xmin'], bb['xmax']),
+					 ylim = c(bb['ymin'], bb['ymax'])) +
+	guides(color = FALSE) +
+	themeMap)
+
+
+
+#add NL map to bloomfield map
+annoBB <- st_sfc(st_point(c(-54.4, 48.1)))
+st_crs(annoBB) <- 4326
+annotateBB <- st_bbox(st_buffer(st_transform(annoBB, utm), 1.3e4))
+
+g <- gblm +
+		annotation_custom(
+			ggplotGrob(gnl),
+			xmin = annotateBB['xmin'],
+			xmax = annotateBB['xmax'],
+			ymin = annotateBB['ymin'],
+			ymax = annotateBB['ymax']
+		)
+
+
+### Output ----
+ggsave(
+	'graphics/09-bloomfield.png',
+	g,
+	width = 10,
+	height = 10,
+	dpi = 320
+)

README.Rmd

@@ -70,7 +70,7 @@ Reproducing: run  `03-newfoundland-prep.R` and `06-terra-nova-prep.R` to generat
 knitr::include_graphics('graphics/07-terra-nova.png')
 ```
 
-4. Terra Nova Bunny Grids
+5. Terra Nova Bunny Grids
 
 This uses data from GeoGratis and Open Street Map and six packages: `osmdata`, `curl`, `zip`, `sf`, `data.table` and `ggplot`. 
 
@@ -80,3 +80,15 @@ Reproducing: run  `03-newfoundland-prep.R` and `06-terra-nova-prep.R` to generat
 ```{r}
 knitr::include_graphics('graphics/08-terra-nova-buns.png')
 ```
+
+6. Bloomfield
+
+This uses data from Open Street Map and six packages: `osmdata`, `curl`, `zip`, `sf`, `data.table` and `ggplot`. 
+
+
+Reproducing: run  `03-newfoundland-prep.R` and `06-terra-nova-prep.R` to generate the NL and TN polygons and `09-bloomfield-figure.R` to combine and generate the figure. 
+
+```{r}
+knitr::include_graphics('graphics/09-bloomfield.png')
+```
+