library(bowen.biodiversity.webapp)
library(here)
#> here() starts at /home/jay/Programming_Projects/bowen.biodiversity.webapp
library(sf)
#> Linking to GEOS 3.11.1, GDAL 3.6.4, PROJ 9.1.1; sf_use_s2() is TRUE
library(tidyverse)
#> ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
#> ✔ dplyr 1.1.4 ✔ readr 2.1.5
#> ✔ forcats 1.0.0 ✔ stringr 1.5.1
#> ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
#> ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
#> ✔ purrr 1.0.2
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag() masks stats::lag()
#> ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(terra)
#> terra 1.8.5
#>
#> Attaching package: 'terra'
#>
#> The following object is masked from 'package:tidyr':
#>
#> extract
library(leaflet)
# Load Bowen Island Mask Created Previously
bowen_island_mask <- here("inst/extdata/bowen_mask.tif") %>%
rast() %>%
project(project_crs)
# Rasterize to Bowen Island Mask
bowen_rasterize <- function(sf) {
output <- sf %>%
terra::vect() %>% # Change to SpatVector for rasterization
terra::project(project_crs) %>% # Reproject to the mask CRS
terra::rasterize(bowen_island_mask,
touches = T,
background = NA) # Rasterize to match mask, set background values to NA
}Prepare habitat layers for input into Zonation. Previously, for the Feb 1 2025 workshop, we used the Sensitive Ecosystem Inventory from Metro Vancouver. These habitat types were originally represented as polygon areas, which was converted to raster.
#### Metro Vancouver Sensitive Ecosystems Inventory ####
# Contents of "data-raw/metrovancouver_sensitive_ecosystem_inventory/" downloaded from MetroVancouver Open Data Catalogue
# GeoPackage download: https://arcg.is/TnfXL
# Reports download: https://metrovancouver.org/services/regional-planning/sensitive-ecosystem-inventory-mapping-app
mvsei <- st_read(here("data-raw/metrovancouver_sensitive_ecosystem_inventory/Sensitive_Ecosystem_Inventory_for_Metro_Vancouver__2020__-5580727563910851507.gpkg")) %>%
st_transform(crs = bowen.biodiversity.webapp::project_crs)
#> Reading layer `Sensitive_Ecosystem_Inventory_for_Metro_Vancouver__2020_' from data source `/home/jay/Programming_Projects/bowen.biodiversity.webapp/data-raw/metrovancouver_sensitive_ecosystem_inventory/Sensitive_Ecosystem_Inventory_for_Metro_Vancouver__2020__-5580727563910851507.gpkg'
#> using driver `GPKG'
#> Simple feature collection with 25637 features and 99 fields
#> Geometry type: MULTIPOLYGON
#> Dimension: XYZ
#> Bounding box: xmin: 468516.6 ymin: 5427679 xmax: 547072.5 ymax: 5495732
#> z_range: zmin: 0 zmax: 0
#> Projected CRS: NAD83 / UTM zone 10N
# Bowen Island SEI
bowen_sei <- mvsei %>%
st_intersection(st_as_sf(bowen.biodiversity.webapp::bowen_boundary))
#> Warning: attribute variables are assumed to be spatially constant throughout
#> all geometriesThere were some areas identified as potentially incorrect during the Feb 1 2025 workshop. We followed up with Alan Whitehead and John Dowler via email for additional details. See issue here: https://github.com/Palen-Lab/bowen.biodiversity.webapp/issues/23
Alan Whitehead provided ponds and wetlands shapefiles, that he had created over the years as an environmental consultant on Bowen Island.
In the first Zonation run, we combined WN for both SECl_1 and SECl_2. This overestimated wetland extent, since this included areas that were more likely to have another habitat quality based off of MV methodology (which was mostly based on aerial surveys). We also pulled out the “Shallow Water” subcategory into its seperate layer.
To improve wetland extent: - Consider all wetland categories in the SEI - Create ranking system of wetland likelihood, by creating separate rasters and summing - WN category in SECl_1 - WN category in SECl_2 - Alan Whitehead’s Wetland Layer
The idea would be that where all three of these agree has the highest likelihood for wetland ecosystems.
# Alan Whitehead's Wetland Layer
wetlands_aw <- bowen.biodiversity.webapp::bowen_wetlands_whitehead_consultants
# Bowen SEI SECl_1
bowen_sei_wn_1 <- bowen_sei %>%
filter(SECl_1 == "WN")
# Bowen SEI SECl_2
bowen_sei_wn_2 <- bowen_sei %>%
filter(SECl_2 == "WN")
wetlands_aw_rast <- bowen_rasterize(wetlands_aw)
bowen_sei_wn_1_rast <- bowen_rasterize(bowen_sei_wn_1)
bowen_sei_wn_2_rast <- bowen_rasterize(bowen_sei_wn_2)
wetlands <- sum(c(wetlands_aw_rast, bowen_sei_wn_1_rast, bowen_sei_wn_2_rast), na.rm = T)The initial Feb1 Zonation run used the SEI categories to represent freshwater ecosystems. Each subcategory of freshwater was used as a distinct layer in the Zonation run. We have since acquired some new layers, which we can simply convert to raster and include as a conservation value input to start.
#### Ponds ####
# Create Ponds Layer from Alan Whitehead's Map and SEI Freshwaster Ponds
ponds_aw <- bowen.biodiversity.webapp::bowen_ponds_whitehead_consultants
ponds_aw
#> Simple feature collection with 122 features and 7 fields
#> Geometry type: MULTIPOLYGON
#> Dimension: XY
#> Bounding box: xmin: 469230.7 ymin: 5464929 xmax: 476786.3 ymax: 5473554
#> Projected CRS: NAD83 / UTM zone 10N
#> First 10 features:
#> ID Area NAME
#> 1 66 196.48 Everhard's Pond
#> 2 67 701.58 Trethewey Pond
#> 3 42 793.69 Ballou Pond
#> 4 78 84.99 un named
#> 5 79 416.44 island
#> 6 80 183.33 un named
#> 7 72 2701.43 Little Josephine Lake
#> 8 36 3962.48 Macleod Pond
#> 9 37 1761.08 Upper Quarry Pond
#> 10 69 816.51 Carter Pond
#> COMMENT OCP_CLASS
#> 1 constructed private pond non-fish bearing
#> 2 constructed private pond non-fish bearing
#> 3 constructed private pond non-fish bearing
#> 4 constructed private pond non-fish bearing
#> 5 island in constructed pond FID43; fix polygon <NA>
#> 6 constructed private pond non-fish bearing
#> 7 constructed private pond, hist. w/ stocked trout tributary to fish-fearing
#> 8 constructed pond, former quarry tributary to fish-bearing
#> 9 constructed pond, former quarry tributary to fish-bearing
#> 10 in Terminal Creek, water source for hatchery fish-bearing
#> Source Perimeter geom
#> 1 <NA> 52 MULTIPOLYGON (((474905.9 54...
#> 2 <NA> 97 MULTIPOLYGON (((475005 5470...
#> 3 <NA> 146 MULTIPOLYGON (((474696.6 54...
#> 4 <NA> 57 MULTIPOLYGON (((470954.3 54...
#> 5 AW 76 MULTIPOLYGON (((471305.8 54...
#> 6 <NA> 52 MULTIPOLYGON (((471427.8 54...
#> 7 <NA> 477 MULTIPOLYGON (((472313.9 54...
#> 8 <NA> 355 MULTIPOLYGON (((471303.8 54...
#> 9 <NA> 163 MULTIPOLYGON (((471181.1 54...
#> 10 <NA> 72 MULTIPOLYGON (((474527 5469...
# Source for ponds is Islands Trust TEM
bowen_sei_fw_pd <- bowen_sei %>%
filter(SEsubcl_1 == "pd" | SEsubcl_2 == "pd") %>%
st_transform(st_crs(ponds_aw))
# Merge ponds
ponds_aw_rast <- bowen_rasterize(ponds_aw)
bowen_sei_fw_pd_rast <- bowen_rasterize(bowen_sei_fw_pd)
ponds_rast <- allNA(c(ponds_aw_rast, bowen_sei_fw_pd_rast)) %>%
classify(matrix(c(F, 1, T, NA), ncol = 2, byrow = T))
#### Lakes ####
bowen_sei_fw_la_rast <- bowen_sei %>%
filter(SEsubcl_1 == "la" | SEsubcl_2 == "la") %>%
bowen_rasterize()
#### Fish Bearing Streams ####
fishbearing_classes <- c(
"fish-bearing", 5,
"tributary to fish-bearing", 4,
"non-fish bearing", 3,
"drainage channel", 2,
NA, 1
) %>%
matrix(ncol = 2, byrow = T)
# Create separate raster for each OCP class
streams_fishbearing_rast <- bowen.biodiversity.webapp::bowen_fish_whitehead_consultants %>%
filter(OCP_CLASS == "fish-bearing") %>%
bowen_rasterize() %>%
classify(matrix(c(1, 5), ncol = 2, byrow = T))
streams_tributary_rast <- bowen.biodiversity.webapp::bowen_fish_whitehead_consultants %>%
filter(OCP_CLASS == "tributary to fish-bearing") %>%
bowen_rasterize() %>%
classify(matrix(c(1, 4), ncol = 2, byrow = T))
streams_nonfishbearing_rast <- bowen.biodiversity.webapp::bowen_fish_whitehead_consultants %>%
filter(OCP_CLASS == "non-fish bearing") %>%
bowen_rasterize() %>%
classify(matrix(c(1, 3), ncol = 2, byrow = T))
streams_drainage_rast <- bowen.biodiversity.webapp::bowen_fish_whitehead_consultants %>%
filter(OCP_CLASS == "drainage channel") %>%
bowen_rasterize() %>%
classify(matrix(c(1, 2), ncol = 2, byrow = T))
streams_NA_rast <- bowen.biodiversity.webapp::bowen_fish_whitehead_consultants %>%
filter(is.na(OCP_CLASS)) %>%
bowen_rasterize() %>%
classify(matrix(c(1, 1), ncol = 2, byrow = T))
# Combine stream rasters together, cover in order of importance
streams_rast <- streams_NA_rast %>%
cover(streams_drainage_rast) %>%
cover(streams_nonfishbearing_rast) %>%
cover(streams_tributary_rast) %>%
cover(streams_fishbearing_rast)
#### Riparian ####
# Combine ff (fringe) and gu (gully) riparian classes into one habitat layer
bowen_sei_ri_rast <- bowen_sei %>%
filter(SECl_1 == "RI" | SECl_2 == "RI") %>%
bowen_rasterize()leaflet(width = "100%", height = "800px") %>%
addProviderTiles(provider = providers$Stadia.AlidadeSmooth) %>%
addRasterImage(x = wetlands_aw_rast, group = "A. Whitehead Wetlands", colors = "lightgreen") %>%
addRasterImage(x = bowen_sei_wn_1_rast, group = "Bowen SEI SECl_1 Wetlands", colors = "green") %>%
addRasterImage(x = bowen_sei_wn_2_rast, group = "Bowen SEI SECl_2 Wetlands", colors = "darkgreen") %>%
addRasterImage(x = bowen_sei_ri_rast, group = "Bowen SEI Riparian", colors = "lightblue") %>%
addRasterImage(x = bowen_sei_fw_la_rast, group = "Bowen SEI Freshwater Lakes", colors = "darkblue") %>%
addRasterImage(x = ponds_rast, group = "Bowen SEI + A. Whitehead Freshwater Ponds", colors = "blue") %>%
addRasterImage(x = streams_rast, group = "A. Whitehead Streams") %>%
addLayersControl(overlayGroups = c("A. Whitehead Wetlands",
"Bowen SEI SECl_1 Wetlands",
"Bowen SEI SECl_2 Wetlands",
"Bowen SEI Riparian",
"Bowen SEI Freshwater Lakes",
"Bowen SEI + A. Whitehead Freshwater Ponds",
"A. Whitehead Streams"
),
options = layersControlOptions(collapsed = F))