- 1.0 Introduction
- 2.0 System setup and installation
- 3.0 Inverse distance-weighted rasters using
hydroweight()
- 4.0 Inverse distance-weighted rasters using
hydroweight_attributes()
- 5.0 Inverse distance-weighted rasters and attributes across multiple layers and sites
- 6.0 Future plans
- 7.0 Acknowledgements
- 8.0 References
- 9.0 Copyright
Environmental scientists often want to calculate landscape statistics within upstream topographic contributing areas (i.e., catchments) to examine their potential effects on a target (e.g., stream network point or waterbody). When calculating landscape statistics like the proportion of upstream urban cover, practitioners typically use a “lumped” approach; this approach gives equal weighting to areas nearby and far away from the target (Peterson et al. 2011).
A more spatially explicit approach could be to generate buffers of successive distances away from the target and calculate the lumped statistics. For example, one could calculate the proportion of urban cover in a 250 m buffer and a 1000 m buffer from the target (Kielstra et al. 2019).
Another approach is to calculate landscape statistics based on distances to the target where areas nearby have more weight than those farther away (i.e., inverse distance-weighting). A set of inverse distance weighting scenarios for stream survey sites was described in Peterson et al. (2011) that included various types of Euclidean and flow-path distances to targets. Tools are implemented as IDW-Plus in ArcGIS (Peterson et al. 2017) as well as in rdwplus in R through GRASS GIS (Pearse et al. 2019).
hydroweight replicates the above approaches but also provides a set of simple and flexible functions to accommodate a wider set of scenarios and statistics (e.g., numerical and categorical rasters and polygons). It also uses the speedy WhiteboxTools (Lindsay 2016, Wu 2020).
There are two functions:
-
hydroweight()
generates distance-weighted rasters for targets on a digital elevation model raster. Examples of targets include single points, areas such as lakes, or linear features such as streams. The function outputs a list oflength(weighting_scheme)
and an accompanying*.rds
file of distance-weighted rasters for targets (target_O
is a point/area target as in iFLO andtarget_S
is a linear feature target as in iFLS in Peterson et al. 2011). IMPORTANTLY, this function acts on a single set of targets but can produce multiple weights. The distance-weighted rasters can be used for generating distance-weighted attributes withhydroweight_attributes()
(e.g., % urban cover weighted by flow distance to a point). See?hydroweight
. -
hydroweight_attributes()
calculates distance-weighted attributes using distance-weighted rasters generated inhydroweight()
, an attribute layer (loi
, e.g., land use raster/polygon), and a region of interest (roi
, e.g., a catchment polygon). The function outputs an attribute summary table or a list that includes the summary table and layers used for calculation. Summary statistics are calculated as in Peterson et al. (2011). IMPORTANTLY, this function only produces one instance of theloi
xdistance_weights
summary statistics (i.e., oneloi
, oneroi
, and one set ofdistance_weights
). See?hydroweight_attributes
.
Workflows are provided below to run these functions across multiple sites and layers.
Distance weights defined by Peterson et al. (2011) are:
Distance weight | Definition | Input layers required |
---|---|---|
lumped | all weights = 1 | dem , target_O /target_S |
iEucO | weighted inverse Euclidean distance to target_O (i.e., stream outlet) |
dem , target_O |
iEucS | weighted inverse Euclidean distance to target_S (i.e., streams) |
dem , target_S |
iFLO | weighted inverse flow-path distance to target_O using d8 flow direction |
dem , target_O |
HAiFLS | hydrologically-active (proportional to flow accumulation) weighted inverse flow-path distance to target_S using d8 flow direction |
dem , target_S , accum |
WhiteboxTools and whitebox are required for hydroweight. See whiteboxR or below for installation.
## Follow instructions for whitebox installation accordingly
## devtools::install_github("giswqs/whiteboxR") # For development version
## whitebox is now available on CRAN
install.packages("whitebox")
library(whitebox)
install_whitebox()
## Possible warning message:
## ------------------------------------------------------------------------
## Could not find WhiteboxTools!
## ------------------------------------------------------------------------
##
## Your next step is to download and install the WhiteboxTools binary:
## > whitebox::install_whitebox()
##
## If you have WhiteboxTools installed already run `wbt_init(exe_path=...)`':
## > wbt_init(exe_path='/home/user/path/to/whitebox_tools')
##
## For whitebox package documentation, ask for help:
## > ??whitebox
##
## For more information visit https://giswqs.github.io/whiteboxR/
##
## ------------------------------------------------------------------------
## Install current version of hydroweight
devtools::install_github("bkielstr/hydroweight@main")
We begin by bringing in our toy digital elevation model and using it to generate terrain products.
## Load libraries
library(dplyr)
library(foreach)
library(hydroweight)
library(raster)
library(sf)
library(viridis)
library(whitebox)
## Import toy_dem from whitebox package
toy_file <- system.file("extdata", "DEM.tif", package = "whitebox")
toy_dem <- raster(x = toy_file, values = TRUE)
crs(toy_dem) <- "+init=epsg:3161"
## Generate hydroweight_dir as a temporary directory
hydroweight_dir <- tempdir()
## Write toy_dem to hydroweight_dir
writeRaster(
x = toy_dem, filename = file.path(hydroweight_dir, "toy_dem.tif"),
overwrite = TRUE
)
## Breach depressions to ensure continuous flow
wbt_breach_depressions(
dem = file.path(hydroweight_dir, "toy_dem.tif"),
output = file.path(hydroweight_dir, "toy_dem_breached.tif")
)
## Generate d8 flow pointer (note: other flow directions are available)
wbt_d8_pointer(
dem = file.path(hydroweight_dir, "toy_dem_breached.tif"),
output = file.path(hydroweight_dir, "toy_dem_breached_d8.tif")
)
## Generate d8 flow accumulation in units of cells (note: other flow directions are available)
wbt_d8_flow_accumulation(
input = file.path(hydroweight_dir, "toy_dem_breached.tif"),
output = file.path(hydroweight_dir, "toy_dem_breached_accum.tif"),
out_type = "cells"
)
## Generate streams with a stream initiation threshold of 2000 cells
wbt_extract_streams(
flow_accum = file.path(hydroweight_dir, "toy_dem_breached_accum.tif"),
output = file.path(hydroweight_dir, "toy_dem_streams.tif"),
threshold = 2000
)
Next we generate a few targets below. Users can provide their own vector
or raster type targets (see ?hydroweight
). Targets are often called
pour points in the literature; here, targets can be a group of raster
cells, polygons, polylines, or points.
Our first target is a low lying area we will call a lake (tg_O
). All
cells <220 m elevation are assigned TRUE
or 1
and those >220 m are
assigned NA
. We also generate its catchment (tg_O_catchment
) using
whitebox::wbt_watershed()
. Our target streams (tg_S
) are loaded from
the whitebox::wbt_extract_streams()
output. Finally, we do some
manipulation to the stream network raster to generate three points along
the stream network (tg_O_multi
) and their catchments
(tg_O_multi_catchment
).
## For hydroweight, there are target_O and target_S
## target_O is a target point/area for calculating distances
## target_S is a stream/linear feature target for calculating distances
## Generate target_O, tg_O, representing a lake.
tg_O <- toy_dem < 220
tg_O[tg_O@data@values != 1] <- NA
writeRaster(tg_O, file.path(hydroweight_dir, "tg_O.tif"), overwrite = TRUE)
tg_O <- rasterToPolygons(tg_O, dissolve = TRUE)
tg_O <- st_as_sf(tg_O)
## Generate catchment for tg_O
wbt_watershed(
d8_pntr = file.path(hydroweight_dir, "toy_dem_breached_d8.tif"),
pour_pts = file.path(hydroweight_dir, "tg_O.tif"),
output = file.path(hydroweight_dir, "tg_O_catchment.tif")
)
tg_O_catchment <- raster(file.path(hydroweight_dir, "tg_O_catchment.tif"))
tg_O_catchment <- rasterToPolygons(tg_O_catchment, dissolve = TRUE)
tg_O_catchment <- st_as_sf(tg_O_catchment)
## Generate target_S, tg_S, representing the stream network
tg_S <- raster(file.path(hydroweight_dir, "toy_dem_streams.tif"))
## Generate target_O, tg_O, representing several points along stream network, and their catchments
tg_O_multi <- raster(file.path(hydroweight_dir, "toy_dem_streams.tif"))
tg_O_multi <- rasterToPoints(tg_O_multi, spatial = TRUE)
tg_O_multi <- st_as_sf(tg_O_multi)
tg_O_multi <- tg_O_multi[st_coordinates(tg_O_multi)[, 1] < 675000, ] # selects single network
tg_O_multi <- tg_O_multi[c(10, 50, 100), ]
tg_O_multi$Site <- c(1, 2, 3)
tg_O_multi_catchment <- foreach(xx = 1:nrow(tg_O_multi), .errorhandling = "pass") %do% {
## Take individual stream point and write to file
sel <- tg_O_multi[xx, ]
st_write(sel, file.path(hydroweight_dir, "tg_O_multi_single.shp"),
delete_layer = TRUE, quiet = TRUE
)
## Run watershed operation on stream point
wbt_watershed(
d8_pntr = file.path(hydroweight_dir, "toy_dem_breached_d8.tif"),
pour_pts = file.path(hydroweight_dir, "tg_O_multi_single.shp"),
output = file.path(hydroweight_dir, "tg_O_multi_single_catchment.tif")
)
## Load catchment and convert to polygon with Site code.
sel_catchment_r <- raster(file.path(hydroweight_dir, "tg_O_multi_single_catchment.tif"))
sel_catchment_r <- rasterToPolygons(sel_catchment_r, dissolve = TRUE)
sel_catchment_r$Site <- sel$Site
sel_catchment_r <- st_as_sf(sel_catchment_r)
return(sel_catchment_r)
}
tg_O_multi_catchment <- bind_rows(tg_O_multi_catchment)
## Plot locations
par(mfrow = c(1, 1))
plot(toy_dem, legend = TRUE, col = viridis(101), cex.axis = 0.75, axis.args = list(cex.axis = 0.75))
plot(tg_S, col = "grey", add = TRUE, legend = FALSE)
plot(st_geometry(tg_O), col = "red", add = TRUE)
plot(st_geometry(tg_O_multi), col = "red", pch = 25, add = TRUE)
plot(st_geometry(tg_O_multi_catchment), col = NA, border = "red", add = TRUE)
legend("bottom", legend = c("target_O sites", "target_S"), fill = c("red", "grey"), horiz = TRUE, bty = "n", cex = 0.75)
Below, hydroweight()
is run using our lake as target_O
for iEucO,
iFLO, and HAiFLO, and using our streams as target_S
for iEucS, iFLS,
and HAiFLS. For export of the distance-weighted rasters, we use “Lake”;
the .rds exported from hydroweight()
to hydroweight_dir
will now be
called “Lake_inv_distances.rds”. Since our DEM is small, we decide to
not clip our region (i.e., clip_region = NULL
). Using
OS_combine = TRUE
, we indicate that distances to the nearest water
feature will be either the lake or stream. Furthermore, for HAiFLO or
HAiFLS, both the lake and streams will be set to NoData for their
calculation as these represent areas of concentrated flow rather than
areas of direct terrestrial-aquatic interaction (see Peterson et al.
2011). Our dem
and flow_accum
are assigned using character strings
with the .tif
files located in hydroweight_dir
. Weighting schemes
and the inverse function are indicated.
Note that these distance-weighted rasters will eventually be clipped to
an roi
- a region of interest like a site’s catchment - in
hydroweight_attributes()
. The value for clipped_region
is really
meant to decrease processing time of large rasters.
See ?hydroweight
for more details.
## Generate inverse distance-weighting function
myinv <- function(x) {
(x * 0.001 + 1)^-1
} ## 0.001 multiplier turns m to km
## Plot inverse distance-weighting function
par(mfrow = c(1, 1))
x <- seq(from = 0, to = 10000, by = 100)
y <- myinv(x)
plot((x / 1000), y, type = "l", xlab = "Distance (km)", ylab = "Weight", bty = "L", cex.axis = 0.75, cex.lab = 0.75)
text(6, 0.8, expression("(Distance + 1)"^-1), cex = 0.75)
## Run hydroweight::hydroweight()
hw_test_1 <- hydroweight::hydroweight(
hydroweight_dir = hydroweight_dir,
target_O = tg_O,
target_S = tg_S,
target_uid = "Lake",
clip_region = NULL,
OS_combine = TRUE,
dem = "toy_dem_breached.tif",
flow_accum = "toy_dem_breached_accum.tif",
weighting_scheme = c(
"lumped", "iEucO", "iFLO", "HAiFLO",
"iEucS", "iFLS", "HAiFLS"
),
inv_function = myinv
)
#> Preparing hydroweight layers @ 2021-12-15 16:44:45
#> Running distance-weighting @ 2021-12-15 16:44:49
## Resultant structure:
# length(hw_test_1) ## 1 set of targets and 7 distance-weighted rasters
# hw_test_1[[1]] ## lumped
# hw_test_1[[2]] ## iEucO
# hw_test_1[[3]] ## iFLO
# hw_test_1[[4]] ## HAiFLO
# hw_test_1[[5]] ## iEucS
# hw_test_1[[6]] ## iFLS
# hw_test_1[[7]] ## HAiFLS
# or
# hw_test_1[["lumped"]]
# hw_test_1[["iEucO"]] etc.
## Plot different weighting schemes; where purple --> yellow == low --> high weight
par(mfrow = c(2, 4), mar = c(1, 1, 1, 1), oma = c(0, 0, 0, 0))
layout(matrix(c(
1, 2, 3, 4,
1, 5, 6, 7
), nrow = 2, byrow = TRUE))
plot(hw_test_1[[1]], main = "Lumped", axes = F, legend = F, box = FALSE, col = viridis(101)[101])
plot(hw_test_1[[2]], main = "iEucO", axes = F, legend = F, box = FALSE, col = viridis(101))
plot(hw_test_1[[3]], main = "iFLO", axes = F, legend = F, box = FALSE, col = viridis(101))
plot(log(hw_test_1[[4]]), main = "HAiFLO", axes = F, legend = F, box = FALSE, col = viridis(101))
plot.new()
plot(hw_test_1[[5]], main = "iEucS", axes = F, legend = F, box = FALSE, col = viridis(101))
plot(hw_test_1[[6]], main = "iFLS", axes = F, legend = F, box = FALSE, col = viridis(101))
plot(log(hw_test_1[[7]]), main = "HAiFLS", axes = F, legend = F, box = FALSE, col = viridis(101))
Important things to note from this plot:
- Lumped is equal weighting where all values = 1.
- iEucO and iEucS distances extend outward to the extent of the DEM.
- For iFLO/HAiFLO/iFLS/HAiFLS, only distances in cells contributing to the areas of interest are included.
- For iFLS/HAiFLS, all regions draining to any streams are included
(i.e., the streams to the east). These would be removed depending on
catchment boundaries of interest when using
hydroweight::hydroweight_attributes()
- As in Peterson et al. (2011), for HAiFLS, the targets are set to NoData (i.e., NA) since they likely represent concentrated flow areas.
These temporary files are made per instance of
hydroweight::hydroweight()
:
list.files(hydroweight_dir)[grep("TEMP-", list.files(hydroweight_dir))]
#> [1] "TEMP-clip_region.dbf" "TEMP-clip_region.prj"
#> [3] "TEMP-clip_region.shp" "TEMP-clip_region.shx"
#> [5] "TEMP-clip_region.tif" "TEMP-cost_backlink.tif"
#> [7] "TEMP-cost_distance.tif" "TEMP-dem_clip.tif"
#> [9] "TEMP-flow_accum_clip.tif" "TEMP-flowdist.tif"
#> [11] "TEMP-HAiFLO.tif" "TEMP-HAiFLS.tif"
#> [13] "TEMP-iEucO.tif" "TEMP-iEucS.tif"
#> [15] "TEMP-iFLO.tif" "TEMP-iFLS.tif"
#> [17] "TEMP-lumped.tif" "TEMP-OS_combine.tif"
#> [19] "TEMP-target_O.dbf" "TEMP-target_O.prj"
#> [21] "TEMP-target_O.shp" "TEMP-target_O.shx"
#> [23] "TEMP-target_O_clip.tif" "TEMP-target_S_clip.tif"
A few options to consider:
## Ignoring target_O
hw_test_2 <- hydroweight::hydroweight(
hydroweight_dir = hydroweight_dir,
target_S = tg_S,
target_uid = "Lake",
clip_region = NULL,
dem = "toy_dem_breached.tif",
flow_accum = "toy_dem_breached_accum.tif",
weighting_scheme = c("lumped", "iEucS", "iFLS", "HAiFLS"),
inv_function = myinv
)
## Resultant structure:
# length(hw_test_3) ## 1 set of targets and 4 distance-weighted rasters
# hw_test_2[[1]] ## lumped
# hw_test_2[[2]] ## iEucS
# hw_test_2[[3]] ## iFLS
# hw_test_2[[4]] ## HAiFLS
## Ignoring target_S
hw_test_3 <- hydroweight::hydroweight(
hydroweight_dir = hydroweight_dir,
target_O = tg_O,
target_uid = "Lake",
dem = "toy_dem_breached.tif",
flow_accum = "toy_dem_breached_accum.tif",
weighting_scheme = c("lumped", "iEucO", "iFLO", "HAiFLO"),
inv_function = myinv
)
# length(hw_test_3) ## 1 set of targets and 4 distance-weighted rasters
# hw_test_3[[1]] ## lumped
# hw_test_3[[2]] ## iEucO
# hw_test_3[[3]] ## iFLO
# hw_test_3[[4]] ## HAiFLO
## Setting a clip region
hw_test_4 <- hydroweight::hydroweight(
hydroweight_dir = hydroweight_dir,
target_O = tg_O,
target_S = tg_S,
target_uid = "Lake",
clip_region = 8000,
OS_combine = TRUE,
dem = "toy_dem_breached.tif",
flow_accum = "toy_dem_breached_accum.tif",
weighting_scheme = c(
"lumped", "iEucO", "iFLO", "HAiFLO",
"iEucS", "iFLS", "HAiFLS"
),
inv_function = myinv
)
## Plot
par(mfrow = c(1, 1), mar = c(1, 1, 1, 1), oma = c(0, 0, 0, 0))
plot(hw_test_1[[1]], main = "iEucO - 8000 m clip", axes = FALSE, legend = FALSE, box = FALSE, col = viridis(101))
plot(hw_test_4[[2]], add = TRUE, axes = FALSE, legend = FALSE, box = FALSE, col = viridis(101))
We wanted users to access intermediate products and also anticipated that layers and/or errors may be very case-specific. For these reasons, we don’t yet provide an all-in-one solution for multiple sites and/or layers of interest but provide workflows instead.
We advocate using foreach
since it is lapply
-like but passes along
errors to allow for later fixing. Linking foreach
with doParallel
allows for parallel processing. (e.g., foreach(...) %dopar%
). We have
not tested whitebox
using parallel processing. However
hydroweight_attributes()
can be run in parallel.
Since hydroweight()
exports an .rds
of its result to
hydroweight_dir
, it allows users to assign the results of
hydroweight()
to an object in the current environment or to run
hydroweight()
alone and upload the .rds
afterwards.
## Run hydroweight across sites found in stream points tg_O_multi/tg_O_multi_catchment
hw_test_5 <- foreach(xx = 1:nrow(tg_O_multi), .errorhandling = "pass") %do% {
message("Running hydroweight for site ", xx, " at ", Sys.time())
hw_test_xx <- hydroweight::hydroweight(
hydroweight_dir = hydroweight_dir,
target_O = tg_O_multi[xx, ], ## Important to change
target_S = tg_S,
target_uid = tg_O_multi$Site[xx], ## Important to change
clip_region = NULL,
OS_combine = TRUE,
dem = "toy_dem_breached.tif",
flow_accum = "toy_dem_breached_accum.tif",
weighting_scheme = c(
"lumped", "iEucO", "iFLO", "HAiFLO",
"iEucS", "iFLS", "HAiFLS"
),
inv_function = myinv
)
return(hw_test_xx)
}
#> Running hydroweight for site 1 at 2021-12-15 16:45:23
#> Preparing hydroweight layers @ 2021-12-15 16:45:23
#> Running distance-weighting @ 2021-12-15 16:45:27
#> Running hydroweight for site 2 at 2021-12-15 16:45:33
#> Preparing hydroweight layers @ 2021-12-15 16:45:33
#> Running distance-weighting @ 2021-12-15 16:45:36
#> Running hydroweight for site 3 at 2021-12-15 16:45:43
#> Preparing hydroweight layers @ 2021-12-15 16:45:43
#> Running distance-weighting @ 2021-12-15 16:45:46
## Resultant structure:
## length(hw_test_5) # 3 sites
## length(hw_test_5[[1]]) # 7 distance-weighted rasters for each site
## hw_test_5[[1]][[1]] # site 1, lumped
## hw_test_5[[1]][[2]] # site 1, iEucO
## hw_test_5[[1]][[3]] # site 1, iFLO
## hw_test_5[[1]][[4]] # site 1, HAiFLO
## hw_test_5[[1]][[5]] # site 1, iEucS
## hw_test_5[[1]][[6]] # site 1, iFLS
## hw_test_5[[1]][[7]] # site 1, HAiFLS
## ...
## ...
## ...
## hw_test_5[[3]][[7]] # site 3, HAiFLS
## Loading up data as if it were not originally assigned to object hw_test_5
inv_distance_collect <- file.path(hydroweight_dir, paste0(tg_O_multi$Site, "_inv_distances.rds"))
hw_test_5 <- lapply(inv_distance_collect, function(x) {
readRDS(x)
})
## Resultant structure:
## length(hw_test_5) # 3 sites
## length(hw_test_5[[1]]) # 7 distance-weighted rasters for each site
## hw_test_5[[1]][[1]] # site 1, lumped
## hw_test_5[[1]][[2]] # site 1, iEucO
## hw_test_5[[1]][[3]] # site 1, iFLO
## hw_test_5[[1]][[4]] # site 1, HAiFLO
## hw_test_5[[1]][[5]] # site 1, iEucS
## hw_test_5[[1]][[6]] # site 1, iFLS
## hw_test_5[[1]][[7]] # site 1, HAiFLS
## ...
## ...
## ...
## hw_test_5[[3]][[7]] # site 3, HAiFLS
## Plot sites, their catchments, and their respective distance-weighted iFLO rasters
par(mfrow = c(1, 3), mar = c(1, 1, 1, 1), oma = c(0, 0, 0, 0))
plot(st_geometry(tg_O_multi_catchment), col = "grey", border = "white", main = "Site 1 - iFLO")
plot(hw_test_5[[1]][[3]], axes = F, legend = F, box = FALSE, col = viridis(101), add = T)
plot(st_geometry(tg_O_multi_catchment), col = "grey", border = "white", main = "Site 2 - iFLO")
plot(hw_test_5[[2]][[3]], axes = F, legend = F, box = FALSE, col = viridis(101), add = T)
plot(st_geometry(tg_O_multi_catchment), col = "grey", border = "white", main = "Site 3 - iFLO")
plot(hw_test_5[[3]][[3]], axes = F, legend = F, box = FALSE, col = viridis(101), add = T)
An advantage of using hydroweight()
is that an iFLO-derived product
can be used as a catchment boundary in subsequent operations. iFLO uses
whitebox::wbt_downslope_distance_to_stream
that uses a D8 flow-routing
algorithm to trace the flow path. Converting all non-NA
iFLO distances
will yield a catchment boundary analogous to
whitebox::wbt_watershed()
. However, we have noticed minor
inconsistencies when comparing catchments derived from the two
procedures when catchment boundaries fall along DEM edges. The procedure
for deriving the catchment boundary for Site 3 is below.
## Pull out iFLO from Site 3, convert non-NA values to 1, then to polygons, then to sf
site3_catchment <- hw_test_5[[3]][["iFLO"]]
site3_catchment[!is.na(site3_catchment)] <- 1
site3_catchment <- rasterToPolygons(site3_catchment, dissolve = T)
site3_catchment <- st_as_sf(site3_catchment)
## Compare
par(mfrow = c(1, 3))
plot(st_geometry(tg_O_multi_catchment[3, ]),
col = adjustcolor("blue", alpha.f = 0.5),
main = "Site 3 catchment \n wbt_watershed-derived"
)
plot(st_geometry(site3_catchment),
col = adjustcolor("red", alpha.f = 0.5),
main = "Site 3 catchment \n hydroweight-derived"
)
plot(st_geometry(site3_catchment), col = adjustcolor("blue", alpha.f = 0.5), main = "Overlap")
plot(st_geometry(tg_O_multi_catchment[3, ]), col = adjustcolor("red", alpha.f = 0.5), main = "Overlap", add = T)
hydroweight_attributes()
uses hydroweight()
output and layers of
interest (loi
) to calculate distance-weighted attributes within a
region of interest (roi
). Inputs can be numeric rasters, categorical
rasters, and polygon data with either numeric or categorical data in the
columns. Internally, all layers are projected to or rasterized to the
spatial resolution of the hydroweight()
output (i.e., the original
DEM).
For numeric inputs, the distance-weighted mean and standard deviation
for each roi
:loi
combination are calculated using
where is the number of
cells, are the
cell weights, and
are loi
cell values,
is the number or non-zero weights, and
is the weighted mean. For categorical inputs, the proportion for each
roi
:loi
combination is calculated using
where when category is present in a cell or when not.
Finally, loi
NA
values are handled differently depending on loi
type. For numeric, NA
cells are excluded from all calculations. If
cell_count
is specified in loi_statistics
(see below), count of
non-NA
cells and NA
cells are returned in the attribute table. For
categorical, NA
cells are considered a category and are included in
the calculated proportions. A prop_NA
column is included in the
attribute table. The lumped_"loi"_prop_NA
would be the true proportion
of NA
cells whereas other columns would be their respective
distance-weighted NA
proportions. This could allow the user to
re-calculate proportions using non-NA
values only.
Using the results of hydroweight()
(i.e., a list of distance-weighted
rasters), we generate distance-weighted attributes for a single site
across the weighting schemes.
First, we generate a numeric raster layer of interest loi = ndvi
and
then summarize those cells falling within the region of interest,
roi = tg_O_catchment
, for each distance-weighted raster in tw_test_1
(all weighting schemes, see above). See ?hydroweight_attributes
for
loi_
- and roi_
-specific information indicating type of data and how
results are returned.
## Construct continuous dataset
ndvi <- toy_dem
values(ndvi) <- runif(n = (ndvi@ncols * ndvi@nrows), min = 0, max = 1)
names(ndvi) <- "ndvi"
hwa_test_numeric <- hydroweight_attributes(
loi = ndvi,
loi_attr_col = "ndvi",
loi_numeric = TRUE,
loi_numeric_stats = c("distwtd_mean", "distwtd_sd", "mean", "sd", "median", "min", "max", "cell_count"),
roi = tg_O_catchment,
roi_uid = "1",
roi_uid_col = "Lake",
distance_weights = hw_test_1,
remove_region = tg_O,
return_products = TRUE
)
names(hwa_test_numeric$attribute_table)
#> [1] "Lake" "lumped_ndvi_mean"
#> [3] "lumped_ndvi_sd" "lumped_ndvi_median"
#> [5] "lumped_ndvi_min" "lumped_ndvi_max"
#> [7] "lumped_ndvi_cell_count" "lumped_ndvi_NA_cell_count"
#> [9] "lumped_ndvi_distwtd_mean" "lumped_ndvi_distwtd_sd"
#> [11] "iEucO_ndvi_distwtd_mean" "iEucO_ndvi_distwtd_sd"
#> [13] "iFLO_ndvi_distwtd_mean" "iFLO_ndvi_distwtd_sd"
#> [15] "HAiFLO_ndvi_distwtd_mean" "HAiFLO_ndvi_distwtd_sd"
#> [17] "iEucS_ndvi_distwtd_mean" "iEucS_ndvi_distwtd_sd"
#> [19] "iFLS_ndvi_distwtd_mean" "iFLS_ndvi_distwtd_sd"
#> [21] "HAiFLS_ndvi_distwtd_mean" "HAiFLS_ndvi_distwtd_sd"
## Resultant structure
## length(hw_test_numeric) # Length 2; 1) attribute table, 2) processing components for 7 inputted distance-weighted rasters
## hw_test_numeric[[1]] == hw_test_numeric$attribute_table # Attribute table
## hw_test_numeric[[2]] == hw_test_numeric$return_products # Processing components for 7 inputted distance-weighted rasters
## hw_test_numeric$return_products$lumped # Processing components used in calculating lumped statistics
## hwa_test_numeric$return_products$lumped$`loi_Raster*_bounded` # Processed loi used in calculating lumped attribute statistics
## hwa_test_numeric$return_products$lumped$distance_weights_bounded # Processed distance-weighted raster used in calculating lumped attribute statistics
## ...
## ...
## ...
## hwa_test_numeric$return_products$HAiFLS$distance_weights_bounded # Processed distance-weighted raster used in calculating HAiFLS attribute statistics
## Plot
par(mfrow = c(1, 1))
plot(ndvi, axes = F, legend = F, box = FALSE, col = viridis(101), main = "Toy NDVI")
plot(st_geometry(tg_O_catchment), col = adjustcolor("grey", alpha.f = 0.5), add = T)
plot(st_geometry(tg_O), col = "red", add = T)
plot(tg_S, col = "blue", add = T, legend = FALSE)
legend("bottom",
legend = c("target_O = tg_O", "target_S = tg_S", "catchment"),
fill = c("red", "blue", adjustcolor("grey", alpha.f = 0.5)), horiz = TRUE, bty = "n", cex = 0.75
)
## Plot results
par(mfrow = c(3, 2), mar = c(1, 1, 1, 1), oma = c(0, 0, 0, 0))
## Lumped
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "Lumped - distance_weights")
plot(hwa_test_numeric$return_products$lumped$distance_weights_bounded, axes = F, legend = F, box = FALSE, col = "yellow", add = TRUE)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "Lumped - distance_weights * ndvi")
plot(hwa_test_numeric$return_products$lumped$`loi_Raster*_bounded` * hwa_test_numeric$return_products$lumped$distance_weights_bounded, axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE)
## iEucO
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iEucO - distance_weights")
plot(hwa_test_numeric$return_products$iEucO$distance_weights_bounded, axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iEucO - distance_weights * ndvi")
plot(hwa_test_numeric$return_products$iEucO$`loi_Raster*_bounded` * hwa_test_numeric$return_products$iEucO$distance_weights_bounded, main = "Lumped \n- loi * distance_weights", axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE)
## iFLS
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iFLS - distance_weights")
plot(hwa_test_numeric$return_products$iFLS$distance_weights_bounded, axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iFLS - distance_weights * ndvi")
plot(hwa_test_numeric$return_products$iFLS$`loi_Raster*_bounded` * hwa_test_numeric$return_products$iFLS$distance_weights_bounded, main = "Lumped \n- loi * distance_weights", axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE)
Here, we generate a categorical raster layer of interest loi = lulc
and then summarize those cells falling within the region of interest,
roi = tg_O_catchment
, for each distance-weighted raster in tw_test_1
(all weighting schemes, see above). See ?hydroweight_attributes
for
loi_
- and roi_
-specific information indicating type of data and how
results are returned.
## Construct categorical dataset by reclassify elevation values into categories
## All values > 0 and <= 220 become 1, etc.
lulc <- toy_dem
m <- c(0, 220, 1, 220, 300, 2, 300, 400, 3, 400, Inf, 4)
rclmat <- matrix(m, ncol = 3, byrow = TRUE)
lulc <- reclassify(lulc, rclmat)
## For each distance weight from hydroweight_test above, calculate the landscape statistics for lulc
hwa_test_categorical <- hydroweight_attributes(
loi = lulc,
loi_attr_col = "lulc",
loi_numeric = FALSE,
roi = tg_O_catchment,
roi_uid = "1",
roi_uid_col = "Lake",
distance_weights = hw_test_1,
remove_region = tg_O,
return_products = TRUE
)
names(hwa_test_categorical$attribute_table)
#> [1] "Lake" "lumped_lulc_prop_1" "lumped_lulc_prop_2"
#> [4] "lumped_lulc_prop_3" "lumped_lulc_prop_4" "iEucO_lulc_prop_1"
#> [7] "iEucO_lulc_prop_2" "iEucO_lulc_prop_3" "iEucO_lulc_prop_4"
#> [10] "iFLO_lulc_prop_1" "iFLO_lulc_prop_2" "iFLO_lulc_prop_3"
#> [13] "iFLO_lulc_prop_4" "HAiFLO_lulc_prop_1" "HAiFLO_lulc_prop_2"
#> [16] "HAiFLO_lulc_prop_3" "HAiFLO_lulc_prop_4" "iEucS_lulc_prop_1"
#> [19] "iEucS_lulc_prop_2" "iEucS_lulc_prop_3" "iEucS_lulc_prop_4"
#> [22] "iFLS_lulc_prop_1" "iFLS_lulc_prop_2" "iFLS_lulc_prop_3"
#> [25] "iFLS_lulc_prop_4" "HAiFLS_lulc_prop_1" "HAiFLS_lulc_prop_2"
#> [28] "HAiFLS_lulc_prop_3" "HAiFLS_lulc_prop_4"
## Resultant structure
## length(hw_test_categorical) # Length 2; 1) attribute table, 2) processing components for 7 inputted distance-weighted rasters
## hw_test_categorical[[1]] == hw_test_categorical$attribute_table # Attribute table
## hw_test_categorical[[2]] == hw_test_categorical$return_products # Processing components for 7 inputted distance-weighted rasters
## hw_test_categorical$return_products$lumped # Processing components used in calculating lumped statistics
## hwa_test_categorical$return_products$lumped$`loi_Raster*_bounded` # Processed loi used in calculating lumped attribute statistics
## hwa_test_categorical$return_products$lumped$distance_weights_bounded # Processed distance-weighted raster used in calculating lumped attribute statistics
## ...
## ...
## ...
## hwa_test_categorical$return_products$HAiFLS$distance_weights_bounded # Processed distance-weighted raster used in calculating HAiFLS attribute statistics
## Plot
par(mfrow = c(1, 1))
plot(lulc, axes = F, legend = F, box = FALSE, col = viridis(4), main = "Toy LULC")
plot(st_geometry(tg_O_catchment), col = adjustcolor("grey", alpha.f = 0.5), add = T)
plot(tg_O, col = "red", add = T, legend = FALSE)
plot(tg_S, col = "blue", add = T, legend = FALSE)
legend("bottom",
legend = c("target_O = tg_O", "target_S = tg_S", "catchment"),
fill = c("red", "blue", adjustcolor("grey", alpha.f = 0.5)), horiz = TRUE, bty = "n", cex = 0.75
)
## Plot results
par(mfrow = c(3, 4), mar = c(1, 1, 1, 1), oma = c(0, 0, 0, 0), cex = 0.75)
## Lumped
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "Lumped")
plot(hwa_test_categorical$return_products$lumped$distance_weights_bounded,
axes = F, legend = F, box = FALSE, col = "yellow", add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "Lumped - loi * lulc (cat: 4)")
plot(hwa_test_categorical$return_products$lumped$distance_weights_bounded *
hwa_test_categorical$return_products$lumped$`loi_Raster*_bounded`[[4]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "Lumped - loi * lulc (cat: 3)")
plot(hwa_test_categorical$return_products$lumped$distance_weights_bounded *
hwa_test_categorical$return_products$lumped$`loi_Raster*_bounded`[[3]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "Lumped - loi * lulc (cat: 2)")
plot(hwa_test_categorical$return_products$lumped$distance_weights_bounded *
hwa_test_categorical$return_products$lumped$`loi_Raster*_bounded`[[2]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
## iEucO
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iEucO")
plot(hwa_test_categorical$return_products$iEucO$distance_weights_bounded,
axes = F, legend = F, box = FALSE, col = "yellow", add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iEucO - loi * lulc (cat: 4)")
plot(hwa_test_categorical$return_products$iEucO$distance_weights_bounded *
hwa_test_categorical$return_products$iEucO$`loi_Raster*_bounded`[[4]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iEucO - loi * lulc (cat: 3)")
plot(hwa_test_categorical$return_products$iEucO$distance_weights_bounded *
hwa_test_categorical$return_products$iEucO$`loi_Raster*_bounded`[[3]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iEucO - loi * lulc (cat: 2)")
plot(hwa_test_categorical$return_products$iEucO$distance_weights_bounded *
hwa_test_categorical$return_products$iEucO$`loi_Raster*_bounded`[[2]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
## iFLO
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iFLO")
plot(hwa_test_categorical$return_products$iFLO$distance_weights_bounded,
axes = F, legend = F, box = FALSE, col = "yellow", add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iFLO - loi * lulc (cat: 4)")
plot(hwa_test_categorical$return_products$iFLO$distance_weights_bounded *
hwa_test_categorical$return_products$iFLO$`loi_Raster*_bounded`[[4]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iFLO - loi * lulc (cat: 3)")
plot(hwa_test_categorical$return_products$iFLO$distance_weights_bounded *
hwa_test_categorical$return_products$iFLO$`loi_Raster*_bounded`[[3]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
plot(st_as_sfc(st_bbox(tg_O_catchment)), border = "white", main = "iFLO - loi * lulc (cat: 2)")
plot(hwa_test_categorical$return_products$iFLO$distance_weights_bounded *
hwa_test_categorical$return_products$iFLO$`loi_Raster*_bounded`[[2]],
axes = F, legend = F, box = FALSE, col = viridis(101), add = TRUE
)
Here, we use lulc
and polygonize the raster to lulc_p
. We then
generate some numeric data in the polygon layer called var_1
and
var_2
. We then spatially summarize the numeric data in those two
columns using hydroweight_attributes()
.
Internally, the lulc
polygons are rasterized using distance_weights
as the template. This basically treats the columns as if they were
individual numeric raster layers. Landscape statistics are calculated
accordingly (e.g., distance-weighted mean). Those cells falling within
the region of interest, roi = tg_O_catchment
, for each
distance-weighted raster in tw_test_1
(all weighting schemes, see
above). See ?hydroweight_attributes
for loi_
- and roi_
-specific
information indicating type of data and how results are returned.
## Construct polygons with numeric data by converting lulc to polygons and assigning values to columns
lulc_p <- rasterToPolygons(lulc, dissolve = T, na.rm = T)
lulc_p <- st_as_sf(lulc_p)
set.seed(123)
lulc_p$var_1 <- sample(c(1:10), size = 4, replace = TRUE)
set.seed(123)
lulc_p$var_2 <- sample(c(20:30), size = 4, replace = TRUE)
## For each distance weight from hydroweight_test above, calculate the landscape statistics for lulc_p
hwa_test_numeric_polygon <- hydroweight_attributes(
loi = lulc_p,
loi_attr_col = "lulc",
loi_columns = c("var_1", "var_2"),
loi_numeric = TRUE,
loi_numeric_stats = c("distwtd_mean", "distwtd_sd", "mean", "sd", "min", "max", "cell_count"),
roi = tg_O_catchment,
roi_uid = "1",
roi_uid_col = "Lake",
distance_weights = hw_test_1,
remove_region = tg_O,
return_products = TRUE
)
names(hwa_test_numeric_polygon$attribute_table)
#> [1] "Lake" "lumped_lulc_var_1_mean"
#> [3] "lumped_lulc_var_2_mean" "lumped_lulc_var_1_sd"
#> [5] "lumped_lulc_var_2_sd" "lumped_lulc_var_1_min"
#> [7] "lumped_lulc_var_2_min" "lumped_lulc_var_1_max"
#> [9] "lumped_lulc_var_2_max" "lumped_lulc_var_1_cell_count"
#> [11] "lumped_lulc_var_2_cell_count" "lumped_lulc_var_1_NA_cell_count"
#> [13] "lumped_lulc_var_2_NA_cell_count" "lumped_lulc_var_1_distwtd_mean"
#> [15] "lumped_lulc_var_2_distwtd_mean" "lumped_lulc_var_1_distwtd_sd"
#> [17] "lumped_lulc_var_2_distwtd_sd" "iEucO_lulc_var_1_distwtd_mean"
#> [19] "iEucO_lulc_var_2_distwtd_mean" "iEucO_lulc_var_1_distwtd_sd"
#> [21] "iEucO_lulc_var_2_distwtd_sd" "iFLO_lulc_var_1_distwtd_mean"
#> [23] "iFLO_lulc_var_2_distwtd_mean" "iFLO_lulc_var_1_distwtd_sd"
#> [25] "iFLO_lulc_var_2_distwtd_sd" "HAiFLO_lulc_var_1_distwtd_mean"
#> [27] "HAiFLO_lulc_var_2_distwtd_mean" "HAiFLO_lulc_var_1_distwtd_sd"
#> [29] "HAiFLO_lulc_var_2_distwtd_sd" "iEucS_lulc_var_1_distwtd_mean"
#> [31] "iEucS_lulc_var_2_distwtd_mean" "iEucS_lulc_var_1_distwtd_sd"
#> [33] "iEucS_lulc_var_2_distwtd_sd" "iFLS_lulc_var_1_distwtd_mean"
#> [35] "iFLS_lulc_var_2_distwtd_mean" "iFLS_lulc_var_1_distwtd_sd"
#> [37] "iFLS_lulc_var_2_distwtd_sd" "HAiFLS_lulc_var_1_distwtd_mean"
#> [39] "HAiFLS_lulc_var_2_distwtd_mean" "HAiFLS_lulc_var_1_distwtd_sd"
#> [41] "HAiFLS_lulc_var_2_distwtd_sd"
## Resultant structure
## length(hw_test_numeric_polygon) # Length 2; 1) attribute table, 2) processing components for 7 inputted distance-weighted rasters
## hw_test_numeric_polygon[[1]] == hw_test_numeric_polygon$attribute_table # Attribute table
## hw_test_numeric_polygon[[2]] == hw_test_numeric_polygon$return_products # Processing components for 7 inputted distance-weighted rasters
## hw_test_numeric_polygon$return_products$lumped # Processing components used in calculating lumped statistics
## hwa_test_numeric_polygon$return_products$lumped$`loi_Raster*_bounded` # Processed loi used in calculating lumped attribute statistics
## hwa_test_numeric_polygon$return_products$lumped$distance_weights_bounded # Processed distance-weighted raster used in calculating lumped attribute statistics
## ...
## ...
## ...
## hwa_test_numeric_polygon$return_products$HAiFLS$distance_weights_bounded # Processed distance-weighted raster used in calculating HAiFLS attribute statistics
Here, we continue to use lulc_p
but specify loi_numeric = FALSE
indicating the data are categorical rather than numeric. Note the final
number in the column names of the summary table is the “category” that
was summarized.
## Construct polygons with categorical data by converting lulc to polygons and assigning values to columns
lulc_p <- rasterToPolygons(lulc, dissolve = T, na.rm = T)
lulc_p <- st_as_sf(lulc_p)
set.seed(123)
lulc_p$var_1 <- sample(c(1:10), size = 4, replace = TRUE)
set.seed(123)
lulc_p$var_2 <- sample(c(20:30), size = 4, replace = TRUE)
## For each distance weight from hydroweight_test above, calculate the landscape statistics for lulc_p
hwa_test_categorical_polygon <- hydroweight_attributes(
loi = lulc_p,
loi_attr_col = "lulc",
loi_columns = c("var_1", "var_2"),
loi_numeric = FALSE,
roi = tg_O_catchment,
roi_uid = "1",
roi_uid_col = "Lake",
distance_weights = hw_test_1,
remove_region = tg_O,
return_products = TRUE
)
names(hwa_test_categorical_polygon$attribute_table)
#> [1] "Lake" "lumped_lulc_prop_var_1_3"
#> [3] "lumped_lulc_prop_var_1_10" "lumped_lulc_prop_var_1_2"
#> [5] "lumped_lulc_prop_var_2_22" "lumped_lulc_prop_var_2_29"
#> [7] "lumped_lulc_prop_var_2_21" "iEucO_lulc_prop_var_1_3"
#> [9] "iEucO_lulc_prop_var_1_10" "iEucO_lulc_prop_var_1_2"
#> [11] "iEucO_lulc_prop_var_2_22" "iEucO_lulc_prop_var_2_29"
#> [13] "iEucO_lulc_prop_var_2_21" "iFLO_lulc_prop_var_1_3"
#> [15] "iFLO_lulc_prop_var_1_10" "iFLO_lulc_prop_var_1_2"
#> [17] "iFLO_lulc_prop_var_2_22" "iFLO_lulc_prop_var_2_29"
#> [19] "iFLO_lulc_prop_var_2_21" "HAiFLO_lulc_prop_var_1_3"
#> [21] "HAiFLO_lulc_prop_var_1_10" "HAiFLO_lulc_prop_var_1_2"
#> [23] "HAiFLO_lulc_prop_var_2_22" "HAiFLO_lulc_prop_var_2_29"
#> [25] "HAiFLO_lulc_prop_var_2_21" "iEucS_lulc_prop_var_1_3"
#> [27] "iEucS_lulc_prop_var_1_10" "iEucS_lulc_prop_var_1_2"
#> [29] "iEucS_lulc_prop_var_2_22" "iEucS_lulc_prop_var_2_29"
#> [31] "iEucS_lulc_prop_var_2_21" "iFLS_lulc_prop_var_1_3"
#> [33] "iFLS_lulc_prop_var_1_10" "iFLS_lulc_prop_var_1_2"
#> [35] "iFLS_lulc_prop_var_2_22" "iFLS_lulc_prop_var_2_29"
#> [37] "iFLS_lulc_prop_var_2_21" "HAiFLS_lulc_prop_var_1_3"
#> [39] "HAiFLS_lulc_prop_var_1_10" "HAiFLS_lulc_prop_var_1_2"
#> [41] "HAiFLS_lulc_prop_var_2_22" "HAiFLS_lulc_prop_var_2_29"
#> [43] "HAiFLS_lulc_prop_var_2_21"
## Resultant structure
## length(hw_test_categorical_polygon) # Length 2; 1) attribute table, 2) processing components for 7 inputted distance-weighted rasters
## hw_test_categorical_polygon[[1]] == hw_test_categorical_polygon$attribute_table # Attribute table
## hw_test_categorical_polygon[[2]] == hw_test_categorical_polygon$return_products # Processing components for 7 inputted distance-weighted rasters
## hw_test_categorical_polygon$return_products$lumped # Processing components used in calculating lumped statistics
## hwa_test_categorical_polygon$return_products$lumped$`loi_Raster*_bounded` # Processed loi used in calculating lumped attribute statistics
## hwa_test_categorical_polygon$return_products$lumped$distance_weights_bounded # Processed distance-weighted raster used in calculating lumped attribute statistics
## ...
## ...
## ...
## hwa_test_categorical_polygon$return_products$HAiFLS$distance_weights_bounded # Processed distance-weighted raster used in calculating HAiFLS attribute statistics
Now that we are familiar with the results structure of hydroweight()
and hydroweight_attributes()
, we use our stream points to demonstrate
how to chain an analysis together across sites, distances weights, and
layers of interest.
The basic chain looks like this this:
- For each site: Run
hydroweight()
- For each layer of interest: Run
hydroweight_attributes()
- For each layer of interest: Run
Here, we try to make the code easier to troubleshoot rather than make it look pretty:
## Sites and catchments
# tg_O_multi ## sites
# tg_O_multi_catchment ## catchments
sites_weights <- foreach(xx = 1:nrow(tg_O_multi), .errorhandling = "pass") %do% {
## Distance-weighted raster component
message("\n******Running hydroweight() on Site ", xx, " of ", nrow(tg_O_multi), " ", Sys.time(), "******")
## Select individual sites and catchments
sel <- tg_O_multi[xx, ]
sel_roi <- subset(tg_O_multi_catchment, Site == sel$Site)
## Run hydroweight
site_weights <- hydroweight::hydroweight(
hydroweight_dir = hydroweight_dir,
target_O = sel, ## Important to change
target_S = tg_S,
target_uid = sel$Site[xx], ## Important to change
clip_region = NULL,
OS_combine = TRUE,
dem = "toy_dem_breached.tif",
flow_accum = "toy_dem_breached_accum.tif",
weighting_scheme = c(
"lumped", "iEucO", "iFLO", "HAiFLO",
"iEucS", "iFLS", "HAiFLS"
),
inv_function = myinv
)
}
names(sites_weights) <- tg_O_multi$Site
## Resultant structure:
## length(sites_weights) # 3 sites
## length(sites_weights[[1]]) # 7 distance-weighted rasters for each site
## sites_weights[[1]][[1]] # site 1, lumped
## sites_weights[[1]][[2]] # site 1, iEucO
## sites_weights[[1]][[3]] # site 1, iFLO
## sites_weights[[1]][[4]] # site 1, HAiFLO
## sites_weights[[1]][[5]] # site 1, iEucS
## sites_weights[[1]][[6]] # site 1, iFLS
## sites_weights[[1]][[7]] # site 1, HAiFLS
## ...
## ...
## ...
## sites_weights[[3]][[7]] # site 3, HAiFLS
## Layers of interest
# ndvi ## numeric raster
# lulc ## categorical raster
# lulc_p_n ## polygon with variables var_1 and var_2 as numeric
# lulc_p_c ## polygon with variables var_1 and var_2 as categorical
loi_ndvi <- list(
loi = ndvi, loi_attr_col = "ndvi", loi_numeric = TRUE,
loi_numeric_stats = c("distwtd_mean", "distwtd_sd", "mean", "sd", "min", "max", "cell_count")
)
loi_lulc <- list(
loi = lulc, loi_attr_col = "lulc", loi_numeric = FALSE
)
loi_lulc_p_n <- list(
loi = lulc_p, loi_attr_col = "lulc", loi_numeric = TRUE,
loi_columns = c("var_1", "var_2"),
loi_numeric_stats = c("distwtd_mean", "distwtd_sd", "mean", "sd", "min", "max", "cell_count")
)
loi_lulc_p_c <- list(
loi = lulc_p, loi_attr_col = "lulc", loi_numeric = FALSE,
loi_columns = c("var_1", "var_2")
)
## These are combined into a list of lists
loi_variable <- list(loi_ndvi, loi_lulc, loi_lulc_p_n, loi_lulc_p_c)
sites_attributes_products <- foreach(xx = 1:nrow(tg_O_multi), .errorhandling = "pass") %do% {
## Distance-weighted raster component
message("\n******Running hydroweight() on Site ", xx, " of ", nrow(tg_O_multi), " ", Sys.time(), "******")
## Select individual sites, catchments, and weights
sel <- tg_O_multi[xx, ]
sel_roi <- subset(tg_O_multi_catchment, Site == sel$Site)
sel_weights <- sites_weights[[sel$Site]]
## Consistent arguments to hydroweight_attributes, not loi-specific. See ?hydroweight_attributes
loi_consist <- list(
roi = sel_roi,
distance_weights = sel_weights,
remove_region = NULL,
return_products = TRUE,
roi_uid = sel$Site,
roi_uid_col = "Site"
)
## For each loi,
sel_layers_hwa <- foreach(yy = 1:length(loi_variable), .errorhandling = "pass") %do% {
## Combine loi_variable[[y]] with loi_consist
loi_combined <- c(loi_variable[[yy]], loi_consist)
## Run hydroweight_attributes using arguments in loi_combined
loi_output <- do.call(hydroweight::hydroweight_attributes, loi_combined)
return(loi_output)
}
return(sel_layers_hwa)
}
length(sites_attributes_products) ## List of results; one list per site
#> [1] 3
length(sites_attributes_products[[1]]) ## List of results for site 1; one list of results per loi
#> [1] 4
length(sites_attributes_products[[1]][[1]]) ## List of results for site 1 and loi 1
#> [1] 2
names(sites_attributes_products[[1]][[1]]$attribute_table) ## Attribute table for site 1 and loi 1
#> [1] "Site" "lumped_ndvi_mean"
#> [3] "lumped_ndvi_sd" "lumped_ndvi_min"
#> [5] "lumped_ndvi_max" "lumped_ndvi_cell_count"
#> [7] "lumped_ndvi_NA_cell_count" "lumped_ndvi_distwtd_mean"
#> [9] "lumped_ndvi_distwtd_sd" "iEucO_ndvi_distwtd_mean"
#> [11] "iEucO_ndvi_distwtd_sd" "iFLO_ndvi_distwtd_mean"
#> [13] "iFLO_ndvi_distwtd_sd" "HAiFLO_ndvi_distwtd_mean"
#> [15] "HAiFLO_ndvi_distwtd_sd" "iEucS_ndvi_distwtd_mean"
#> [17] "iEucS_ndvi_distwtd_sd" "iFLS_ndvi_distwtd_mean"
#> [19] "iFLS_ndvi_distwtd_sd" "HAiFLS_ndvi_distwtd_mean"
#> [21] "HAiFLS_ndvi_distwtd_sd"
names(sites_attributes_products[[1]][[1]]$return_products) ## Return products for site 1 and loi 1 per distance-weighted raster
#> [1] "lumped" "iEucO" "iFLO" "HAiFLO" "iEucS" "iFLS" "HAiFLS"
sites_attributes_list <- foreach(xx = 1:length(sites_attributes_products), .errorhandling = "pass") %do% {
## Selects an individual site
sel_site <- sites_attributes_products[[xx]]
## Selects distance-weighted raster results set
site_stats <- foreach(yy = 1:length(sel_site), .errorhandling = "pass") %do% {
sel_site[[yy]]$attribute_table
}
## Merges the distance-weighted raster-specific datasets
site_stats <- Reduce(merge, site_stats)
return(site_stats)
}
## Bind rows
sites_attributes_df <- bind_rows(sites_attributes_list)
## If a raster category was missing in a site's catchment but was present in another site's,
## that record would be filled with NA according to bind_rows. Need to fix this.
## This is only true for columns containing "prop".
sites_attributes_df[, grep("prop", colnames(sites_attributes_df))][is.na(sites_attributes_df[, grep("prop", colnames(sites_attributes_df))])] <- 0
## Final data frame
colnames(sites_attributes_df)
#> [1] "Site" "lumped_ndvi_mean"
#> [3] "lumped_ndvi_sd" "lumped_ndvi_min"
#> [5] "lumped_ndvi_max" "lumped_ndvi_cell_count"
#> [7] "lumped_ndvi_NA_cell_count" "lumped_ndvi_distwtd_mean"
#> [9] "lumped_ndvi_distwtd_sd" "iEucO_ndvi_distwtd_mean"
#> [11] "iEucO_ndvi_distwtd_sd" "iFLO_ndvi_distwtd_mean"
#> [13] "iFLO_ndvi_distwtd_sd" "HAiFLO_ndvi_distwtd_mean"
#> [15] "HAiFLO_ndvi_distwtd_sd" "iEucS_ndvi_distwtd_mean"
#> [17] "iEucS_ndvi_distwtd_sd" "iFLS_ndvi_distwtd_mean"
#> [19] "iFLS_ndvi_distwtd_sd" "HAiFLS_ndvi_distwtd_mean"
#> [21] "HAiFLS_ndvi_distwtd_sd" "lumped_lulc_prop_1"
#> [23] "lumped_lulc_prop_2" "lumped_lulc_prop_3"
#> [25] "lumped_lulc_prop_4" "iEucO_lulc_prop_1"
#> [27] "iEucO_lulc_prop_2" "iEucO_lulc_prop_3"
#> [29] "iEucO_lulc_prop_4" "iFLO_lulc_prop_1"
#> [31] "iFLO_lulc_prop_2" "iFLO_lulc_prop_3"
#> [33] "iFLO_lulc_prop_4" "HAiFLO_lulc_prop_1"
#> [35] "HAiFLO_lulc_prop_2" "HAiFLO_lulc_prop_3"
#> [37] "HAiFLO_lulc_prop_4" "iEucS_lulc_prop_1"
#> [39] "iEucS_lulc_prop_2" "iEucS_lulc_prop_3"
#> [41] "iEucS_lulc_prop_4" "iFLS_lulc_prop_1"
#> [43] "iFLS_lulc_prop_2" "iFLS_lulc_prop_3"
#> [45] "iFLS_lulc_prop_4" "HAiFLS_lulc_prop_1"
#> [47] "HAiFLS_lulc_prop_2" "HAiFLS_lulc_prop_3"
#> [49] "HAiFLS_lulc_prop_4" "lumped_lulc_var_1_mean"
#> [51] "lumped_lulc_var_2_mean" "lumped_lulc_var_1_sd"
#> [53] "lumped_lulc_var_2_sd" "lumped_lulc_var_1_min"
#> [55] "lumped_lulc_var_2_min" "lumped_lulc_var_1_max"
#> [57] "lumped_lulc_var_2_max" "lumped_lulc_var_1_cell_count"
#> [59] "lumped_lulc_var_2_cell_count" "lumped_lulc_var_1_NA_cell_count"
#> [61] "lumped_lulc_var_2_NA_cell_count" "lumped_lulc_var_1_distwtd_mean"
#> [63] "lumped_lulc_var_2_distwtd_mean" "lumped_lulc_var_1_distwtd_sd"
#> [65] "lumped_lulc_var_2_distwtd_sd" "iEucO_lulc_var_1_distwtd_mean"
#> [67] "iEucO_lulc_var_2_distwtd_mean" "iEucO_lulc_var_1_distwtd_sd"
#> [69] "iEucO_lulc_var_2_distwtd_sd" "iFLO_lulc_var_1_distwtd_mean"
#> [71] "iFLO_lulc_var_2_distwtd_mean" "iFLO_lulc_var_1_distwtd_sd"
#> [73] "iFLO_lulc_var_2_distwtd_sd" "HAiFLO_lulc_var_1_distwtd_mean"
#> [75] "HAiFLO_lulc_var_2_distwtd_mean" "HAiFLO_lulc_var_1_distwtd_sd"
#> [77] "HAiFLO_lulc_var_2_distwtd_sd" "iEucS_lulc_var_1_distwtd_mean"
#> [79] "iEucS_lulc_var_2_distwtd_mean" "iEucS_lulc_var_1_distwtd_sd"
#> [81] "iEucS_lulc_var_2_distwtd_sd" "iFLS_lulc_var_1_distwtd_mean"
#> [83] "iFLS_lulc_var_2_distwtd_mean" "iFLS_lulc_var_1_distwtd_sd"
#> [85] "iFLS_lulc_var_2_distwtd_sd" "HAiFLS_lulc_var_1_distwtd_mean"
#> [87] "HAiFLS_lulc_var_2_distwtd_mean" "HAiFLS_lulc_var_1_distwtd_sd"
#> [89] "HAiFLS_lulc_var_2_distwtd_sd" "lumped_lulc_prop_var_1_3"
#> [91] "lumped_lulc_prop_var_1_10" "lumped_lulc_prop_var_1_2"
#> [93] "lumped_lulc_prop_var_2_22" "lumped_lulc_prop_var_2_29"
#> [95] "lumped_lulc_prop_var_2_21" "iEucO_lulc_prop_var_1_3"
#> [97] "iEucO_lulc_prop_var_1_10" "iEucO_lulc_prop_var_1_2"
#> [99] "iEucO_lulc_prop_var_2_22" "iEucO_lulc_prop_var_2_29"
#> [101] "iEucO_lulc_prop_var_2_21" "iFLO_lulc_prop_var_1_3"
#> [103] "iFLO_lulc_prop_var_1_10" "iFLO_lulc_prop_var_1_2"
#> [105] "iFLO_lulc_prop_var_2_22" "iFLO_lulc_prop_var_2_29"
#> [107] "iFLO_lulc_prop_var_2_21" "HAiFLO_lulc_prop_var_1_3"
#> [109] "HAiFLO_lulc_prop_var_1_10" "HAiFLO_lulc_prop_var_1_2"
#> [111] "HAiFLO_lulc_prop_var_2_22" "HAiFLO_lulc_prop_var_2_29"
#> [113] "HAiFLO_lulc_prop_var_2_21" "iEucS_lulc_prop_var_1_3"
#> [115] "iEucS_lulc_prop_var_1_10" "iEucS_lulc_prop_var_1_2"
#> [117] "iEucS_lulc_prop_var_2_22" "iEucS_lulc_prop_var_2_29"
#> [119] "iEucS_lulc_prop_var_2_21" "iFLS_lulc_prop_var_1_3"
#> [121] "iFLS_lulc_prop_var_1_10" "iFLS_lulc_prop_var_1_2"
#> [123] "iFLS_lulc_prop_var_2_22" "iFLS_lulc_prop_var_2_29"
#> [125] "iFLS_lulc_prop_var_2_21" "HAiFLS_lulc_prop_var_1_3"
#> [127] "HAiFLS_lulc_prop_var_1_10" "HAiFLS_lulc_prop_var_1_2"
#> [129] "HAiFLS_lulc_prop_var_2_22" "HAiFLS_lulc_prop_var_2_29"
#> [131] "HAiFLS_lulc_prop_var_2_21"
Now - like any good environmental scientist - you have more variables and/or metrics than sites.
This package was implemented to mostly serve our purposes and is functional enough. There is probably lots of room for improvement that we don’t see yet.
The core functions should stay the same but we would like to:
- Optimize for speed based on user/my own feedback.
- Potentially use less in-memory
raster
functions in favour ofWhiteboxTools
functions. - Work on moving multi-site/multi-layer capability into their own functions based on feedback.
- Implement tidier data handling and results structures.
- … as things come up.
Thank you to for early review/testing (alphabetical order):
Darren McCormick, Courtney Mondoux, Emily Smenderovac
We acknowledge the funding support of Natural Resources Canada, the Ontario Ministry of Natural Resources, and a Natural Sciences and Engineering Research Council of Canada Strategic Partnership Grant (STPGP 521405-2018).
Kielstra, B. W., Chau, J., & Richardson, J. S. (2019). Measuring function and structure of urban headwater streams with citizen scientists. Ecosphere, 10(4):e02720. https://doi.org/10.1002/ecs2.2720
Lindsay, J.B. (2016). Whitebox GAT: A case study in geomorphometric analysis. Computers & Geosciences, 95: 75-84. https://doi.org/10.1016/j.cageo.2016.07.003
Peterson, E. E., Sheldon, F., Darnell, R., Bunn, S. E., & Harch, B. D. (2011). A comparison of spatially explicit landscape representation methods and their relationship to stream condition. Freshwater Biology, 56(3), 590–610. https://doi.org/10.1111/j.1365-2427.2010.02507.x
Peterson, E. E. & Pearse, A. R. (2017). IDW‐Plus: An ArcGIS Toolset for calculating spatially explicit watershed attributes for survey sites. Journal of the American Water Resources Association, 53(5): 1241–1249. https://doi.org/10.1111/1752-1688.12558
Pearse, A., Heron, G., & Peterson, E. (2019). rdwplus: An Implementation of IDW-PLUS. R package version 0.1.0. https://CRAN.R-project.org/package=rdwplus
R Core Team (2021). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. https://www.R-project.org/
Wickham, H., Bryan, J. (2021). R Packages. 2nd edition. https://r-pkgs.org/.
Wu, Q. (2020). whitebox: ‘WhiteboxTools’ R Frontend. R package version 1.4.0. https://github.com/giswqs/whiteboxR
Copyright (C) 2021 Her Majesty the Queen in Right of Canada, as represented by the Minister of Natural Resources Canada