In FluvialGeomorph/fluvgeo: A Package for Fluvial Geomorphic Analysis

library(sf)
library(dplyr)
library(knitr)
library(pander)
library(ggplot2)
library(ggrepel)
library(tmap)

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"
}

Study Area Overview: `r params$stream`

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))
}

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_L3(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))

Width Depth Ratio

# Create the fluvgeo::FluvialGeomorphicMetric object
wdr <- new(Class = "FluvialGeomorphicMetric",
           metric = "Width Depth Ratio",
           definition = "bankfull width / bankfull depth",
           variable = "xs_width_depth_ratio",
           threshold_breaks = c(0, 10, 20, Inf),
           threshold_labels = c("Incised",
                                "Stable",
                                "Overwidened"),
           source = "Dunn & Leopold, 1978")

# Create the reach metric map
print(fluvgeo::map_reach_metric(wdr,
                                flowline = params$flowline_sf,
                                xs_label_freq = params$xs_label_freq,
                                xs_dimensions = params$xs_dims_sf))

print(fluvgeo::xs_metric_plot(metric = wdr,
                              reach_xs_dims = params$xs_dims_sf,
                              label_xs = TRUE,
                              xs_label_freq = params$xs_label_freq,
                              profile_units = params$profile_units))

Radius of Curvature to Bankfull Width

# Create the FluvialGeomorphicMetric object
rc_bfw <- new(Class = "FluvialGeomorphicMetric",
              metric = "Radius of Curvature to Bankfull Width Ratio",
              definition = "radius of curvature / bankfull width",
              variable = "rc_bfw_ratio",
              threshold_breaks = c(0, 1.6, 2.0, Inf),
              threshold_labels = c("Unstable",
                                   "Relatively Stable",
                                   "Stable"),
              source = "Haring, personal communication")

# Create the reach metric map
print(fluvgeo::map_reach_metric(rc_bfw,
                                flowline = params$flowline_sf,
                                xs_label_freq = params$xs_label_freq,
                                xs_dimensions = params$xs_dims_sf))

print(fluvgeo::xs_metric_plot(metric = rc_bfw,
                              reach_xs_dims = params$xs_dims_sf,
                              label_xs = TRUE,
                              xs_label_freq = params$xs_label_freq,
                              profile_units = params$profile_units))

Cross Section Geometry

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

# Calculate cross section dimensions
xs_pts <- params$xs_pts_sf_list[[1]]

# Calculate cross section dimensions for the reach regional curves graph
xs_dims <- xs_dimensions(xs_points = xs_pts,
                         streams = params$stream,
                         regions = params$regions,
                         bankfull_elevations = c(params$bf_estimate))

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

Cross Section Profiles

This section displays cross section profile graphs for each riffle cross section in this stream reach. A table of cross section hydraulic geometry dimensions appears under each cross section profile. The first row contains the hydraulic geometry dimensions for the selected region, while the second row contains hydraulic geometry dimensions for the current cross section.

if(params$show_xs_map) {
  # Get dem raster
  dem_rast <- fluvgeo::gdb_raster2SpatRast(raster_path = params$dem)
}
# Get the xs_points for the base year survey
xs_pts <- params$xs_pts_sf_list[[1]]

# Iterate through xs'ss creating: map, cross section plot, and RHG table
for (j in as.integer(levels(as.factor(xs_pts$Seq)))) {
  # Create the cross section map
  if(params$show_xs_map) {
  print(fluvgeo::map_xs(cross_section = params$xs_sf,
                        xs_number = j,
                        dem = dem_rast,
                        extent_factor = params$extent_factor))
  }
  pander::pandoc.p('')
  # Create the cross section plot
  print(fluvgeo::xs_compare_plot_L2(stream = params$stream,
                                    xs_number = j,
                                    xs_pts_sf_list = params$xs_pts_sf_list,
                                    bankfull_elevation = params$bf_estimate,
                                    aspect_ratio = 0.4))
  # Calculate cross section geometry
  xs_pts_j <- xs_pts[xs_pts$Seq == j, ]
  dims <- fluvgeo::xs_dimensions(xs_points = xs_pts_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
  t <- knitr::kable(x = dims_sort[, c("xs_type", "drainage_area", "xs_area", 
                                      "xs_width", "xs_depth")],
                    format = format,
                    digits = 1,
                    row.names = FALSE,
                    col.names = c("Cross Section Type", "Drainage Area", 
                                  "Area", "Width", "Depth"))
  # Use knitr print function to ensure table is drawn properly
  knitr:::print.knitr_kable(t)
  # Insert vertical white space so that next figure in loop is recognized
  cat('\n')
  # Must set chunk option`results='asis'` to ensure table is drawn properly
}