In FluvialGeomorph/fluvgeo: A Package for Fluvial Geomorphic Analysis

library(assertthat)
library(dplyr)
library(knitr)
library(rmarkdown)
library(kableExtra)
library(Metrics)
library(ggplot2)
library(ggrepel)
library(reshape2)

if (params$output_format == "html_document") {
  options(knitr.table.format = "html")
  format <- "html"
}
if (params$output_format == "pdf_document") {
  options(knitr.table.format = "latex")
  format <- "latex"
}
if (params$output_format == "word_document") {
  options(knitr.table.format = "pandoc")
  format <- "pandoc"
}

`r params$stream`

The purpose of this analysis is to identify the bankfull elevation over a set of riffle cross sections for an ungaged stream reach by using regional hydraulic relationships.

Study Area Overview

if(aerial) {
  print(fluvgeo::map_reach_overview(flowline = params$flowline_sf, 
                                    cross_section = params$xs_dims_sf,
                                    background = "aerial",
                                    xs_label_freq = params$xs_label_freq,
                                    extent_factor = params$extent_factor))
}

if(elevation) {
  print(fluvgeo::map_reach_overview(flowline = flowline_sf, 
                                    cross_section = params$xs_dims_sf,
                                    background = "elevation",
                                    xs_label_freq = params$xs_label_freq,
                                    exaggeration = params$exaggeration,
                                    extent_factor = params$extent_factor))
}

Bankfull Elevation Sensitivity Analysis

To help inform the estimation of a bankfull elevation, this section contains a sensitivity analysis of a goodness of fit metric (i.e., mean average error) calculated using this stream reach's riffle cross sections as compared to estimated dimensions from regional relationships for several hydraulic geometry dimensions. The table below contains a summary of the goodness of fit statistics for the selected bankfull elevation for the selected analysis regions.

# Get the xs_points for the base year survey
xs_pts_ch <- params$xs_pts_ch_sf_list[[1]]
# Calculate cross section dimensions
xs_dims <- fluvgeo::xs_dimensions(xs_points = xs_pts_ch,
                               streams = params$stream,
                               regions = params$regions,
                               bankfull_elevations = params$bankfull_elevations)
# Calculate the gof stats
gof_stats <- fluvgeo::build_gof_stats(xs_dims = xs_dims,
                               streams = params$stream,
                               regions = params$regions,
                               bankfull_elevations = params$bankfull_elevations)

# Draw goodness of fit graph
print(fluvgeo::gof_graph(gof_stats = gof_stats,
                         stream = params$stream,
                         bankfull_elevation = params$bf_estimate,
                         stat = "MAE"))

# Subset the gof_stats data frame for the current bankfull elevation
bf_stats <- gof_stats[gof_stats$bankfull_elevation == params$bf_estimate, ]
# Select only the fields needed
bf_stats <- bf_stats[, c("region", "bankfull_elevation", "mae_area",
                         "mae_width", "mae_depth")]
# Format the table
k <- knitr::kable(x = bf_stats,
                  format = format,
                  digits = 2,
                  row.names = FALSE,
                  col.names = c("Regions", "Bankfull Elevation",
                                "Area (MAE, sq feet)", "Width (MAE, feet)",
                                "Depth (MAE, feet)"),
                  caption = paste0("Goodness of fit for all cross sections at ",
                                   "bankfull elevation ", params$bf_estimate,
                                   " (detrended ft) using Mean Average Error ",
                                   "(MAE)."),
                  booktabs = TRUE)
ks <- kableExtra::kable_styling(kable_input = k,
                                bootstrap_options = c("striped", "hover"),
                                latex_options = c("striped", "scale_down"))
print(ks)

The figure below displays the selected regional hydraulic geometry curves plotted with the values for each of the cross sections in the current reach.

# Draw reach regional curves graph
print(fluvgeo::reach_rhg_graph(xs_dims = xs_dims,
                               streams = params$stream,
                               bf_elevation = params$bf_estimate))

Longitudinal Profile

print(fluvgeo::xs_profile_plot(reach_xs_dims = xs_dims_sf, 
                               features = features_sf, 
                               label_xs = params$label_xs,
                               xs_label_freq = params$xs_label_freq,
                               profile_units = params$profile_units))

Cross Section Metrics

print(fluvgeo::xs_metrics_plot_L2(xs_dims_sf = params$xs_dims_sf, 
                                 features_sf = params$features_sf,
                                 label_xs = params$label_xs,
                                 xs_label_freq = params$xs_label_freq,
                                 profile_units = params$profile_units))

Cross Section Profiles

This section displays cross section profile graphs for each riffle cross section in this stream reach. The blue horizontal line represents the estimated water surface elevation. A table of cross section hydraulic geometry dimensions calculated for the current cross section appears under each graph.

if(params$show_xs_map) {
  # Get dem raster
  dem_rast <- fluvgeo::gdb_raster2SpatRast(raster_path = params$dem)
}

# Ensure that cross sections are sequentially ordered
cross_section <- dplyr::arrange(params$xs_dims_sf, Seq)

# Iterate through xs's
for (j in as.integer(levels(as.factor(cross_section$Seq)))) {
  if(params$show_xs_map) {
    # Create the cross section plot
    print(fluvgeo::map_xs(cross_section = params$xs_dims_sf,
                          xs_number = j,
                          dem = dem_rast,
                          extent_factor = params$extent_factor * 3))
  }
  pander::pandoc.p('')
  print(fluvgeo::xs_compare_plot_L2(stream = params$stream,
                                    xs_number = j,
                                    xs_pts_sf_list = params$xs_pts_fp_sf_list,
                                    bankfull_elevation = params$bf_estimate,
                                    aspect_ratio = 0.4))

  print(fluvgeo::xs_compare_plot_L2(stream = params$stream,
                                    xs_number = j,
                                    xs_pts_sf_list = params$xs_pts_ch_sf_list,
                                    bankfull_elevation = params$bf_estimate,
                                    aspect_ratio = 0.8))
  # Calculate cross section geometry
  xs_pts_ch_j <- xs_pts_ch[xs_pts_ch$Seq == j, ]
  dims <- fluvgeo::xs_dimensions(xs_points = xs_pts_ch_j,
                                 streams = params$stream,
                                 regions = params$regions,
                                 bankfull_elevations = params$bf_estimate)
  # Remove duplicate 'DEM derived cross section' records
  dims_unique <- unique(dims)
  # Sort by 'xs_type'
  dims_sort <- dims_unique[order(dims_unique$xs_type), ]
  # Create kable table to display cross section dimensions
  p <- knitr::kable(x = dims_sort[, c("xs_type", "drainage_area", "xs_area",
                                      "xs_width", "xs_depth")],
                    format = format,
                    digits = 2,
                    row.names = FALSE,
                    col.names = c("Cross Section Type", "Drainage Area",
                                  "Area", "Width", "Depth"),
                    booktabs = TRUE)
  ps <- kableExtra::kable_styling(kable_input = p,
                                  font_size = 8,
                                  fixed_thead = TRUE)
  print(ps)
  # Insert vertical white space so that next figure is recognized
  cat('\n')
}