Merge pull request #35 from FluvialGeomorph/mean_depth

Mean depth
FluvialGeomorph · Apr 2, 2024 · 4d281d8 · 4d281d8
2 parents cca0471 + 9fb9efb
commit 4d281d8
Show file tree

Hide file tree

Showing 13 changed files with 71 additions and 46 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: fluvgeo
 Title: A Package for Fluvial Geomorphic Analysis
-Version: 0.1.47
+Version: 0.1.49
 Authors@R: c(
     person("Michael", "Dougherty", 
            email = "Michael.P.Dougherty@usace.army.mil", 
@@ -63,4 +63,4 @@ Imports:
     tidyr,
     tmap,
     utils
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,14 @@
+# fluvgeo v0.1.49 (2024-04-02)
+
+## Major changes
+* The function `xs_geometry` previously calculated the maximum cross section depth and was changed to calculate the mean depth of each cross section. This change was made to better align with the hydraulic geometry literature. 
+* Configured the `slope_sinuosity` function to optionally smooth the `flowline_points` z-elevations. As the quality of LiDAR data collection continually increases, there is less need to smooth longitudinal profile z-elevations. 
+
+## Minor changes
+* Added field survey test data. 
+
+***
+
 # fluvgeo v0.1.48 (2023-09-07)
 
 ## Major changes
@@ -9,7 +20,7 @@
 ## Minor changes
 * Continued substituting `terra` functions to replace `raster` functions ahead of its decommissioning. 
 
-
+***
 
 # fluvgeo v0.1.46 (2023-08-21)
 
@@ -23,7 +34,7 @@ See [Issue 26](https://github.com/FluvialGeomorph/fluvgeo/issues/26)
 ## Minor changes
 * None
 
-
+***
 
 # fluvgeo v0.1.45 (2023-03-21)
 
@@ -37,7 +48,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 ## Minor changes
 * Added `terra` functions to replace `raster` functions in elevation map hillshade generation.
 
-
+***
 
 # fluvgeo v0.1.44 (2023-03-01)
 
@@ -48,7 +59,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * Added `maptiles` get_tiles function to address `ceramic` display issues for aerial imagery in reports.
 See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 
-
+***
 
 # fluvgeo v0.1.43 (2023-02-09)
 
@@ -58,7 +69,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 ## Bug Fixes
 * The R package `ceramic` is passing GDAL output that is interrupting the display of maps in reports. 
 
-
+***
 
 # fluvgeo v0.1.42 (2023-01-21)
 
@@ -76,7 +87,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * Since no comprehensive solution is currently being provided for these issues in `arc.write`, we have chosen to minimize our exposure. We have decided to only write table data back to the file geodatabase. 
 * If the `arcgisbinging` team addresses these issues, we may choose to go back to trusting the writing of file geodatabase feature classes using `arc.write`.  
 
-
+***
 
 # fluvgeo v0.1.38 (2023-01-21)
 
@@ -93,6 +104,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * Developed workaround to the [`arcgisbinding` failure to comprehensively handle coordinate reference system conversions between ESRI-GDAL-ESRI](https://github.com/R-ArcGIS/r-bridge/issues/38). The workaround is to require the user to read and write geodatabase (GDB) feature classes into a feature dataset. The feature dataset then enforces the coordinate reference system. 
 * Determined that the `arcgisbinding` recommendation to handle coordinate reference system conversions between ESRI-GDAL/PROJ6-ESRI using the `arc.write()` `shape_info` method does not work, [Issue 38](https://github.com/R-ArcGIS/r-bridge/issues/38). 
 
+***
 
 # fluvgeo v0.1.36 (2022-11-15)
 
@@ -101,7 +113,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * Fixed bug when calculating sinuosity when linear units not meters. 
 * Identified ESRI arcgisbinding bug in properly handling coordinate reference systems on read and write (see `arcgisbinding` issue 26 & 38) (https://github.com/R-ArcGIS/r-bridge/issues/38)[https://github.com/R-ArcGIS/r-bridge/issues/38]. 
 
-
+***
 
 # fluvgeo v0.1.35 (2021-02-28)
 
@@ -112,6 +124,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 ## Bug Fixes
 * Updated and cleaned test data.  
 
+***
 
 # fluvgeo v0.1.34 (2020-12-14)
 
@@ -121,6 +134,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 ## Bug Fixes
 * Updated Cole Creek test data.  
 
+***
 
 # fluvgeo v0.1.33 (2020-11-21)
 
@@ -130,13 +144,15 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 ## Bug Fixes
 * Updated the `slope_sinuosity` function to ensure that coordinate systems with linear units of meters, feet, or US survey feet are handled properly. 
 
+***
 
 # fluvgeo v0.1.32 (2020-09-27)
 
 ## Bug Fixes
 * Fixed a bug that prevented the Level 1 and 2 reports from displaying slope. 
 * Adjusted the `loess_span` default values. 
 
+***
 
 # fluvgeo v0.1.31 (2020-09-21)
 
@@ -151,6 +167,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * Clarified the x-axis label in the `xs_compare_plot_*` to more clearly communicate the orientation of the cross section. 
 * Restructured the way XS maps are drawn in reports when called in a loop. Changed the `map_xs` function to accept a `raster::RasterLayer` so that the site DEM is only loaded once rather than being loaded each time the `map_xs` function is called. 
 
+***
 
 # fluvgeo v0.1.30 (2020-09-13)
 
@@ -167,6 +184,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * `check_cross_section_dimensions` now accepts sf input. 
 * Fixed some failing tests.
 
+***
 
 # fluvgeo v0.1.29 (2020-09-07)
 
@@ -182,6 +200,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * Updated the `map_reach_overview` to use the `ceramic` R package to retrieve  [Mapbox](https://www.mapbox.com/maps/satellite) aerial photos and coarse-scale elevation in place of the broken `tmaptools::read_osm`. 
 * Removed the floodprone water surface series from the longitudinal profile graph. 
 
+***
 
 # fluvgeo v0.1.28 (2020-08-31)
 
@@ -195,6 +214,8 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * Fixed examples.
 * Lots of little bug fixes. R CMD check now runs with only test errors. 
 
+***
+
 # fluvgeo v0.1.27 (2020-08-16)
 
 ## Major Changes
@@ -207,6 +228,7 @@ See [Issue 20](https://github.com/FluvialGeomorph/fluvgeo/issues/20)
 * Sort Level 1 report cross sections. 
 * Fixed `Estimate Bankfull` report. 
 
+***
 
 # fluvgeo v0.1.26 (2020-07-23)
 

diff --git a/R/slope_sinuosity.R b/R/slope_sinuosity.R
@@ -44,7 +44,7 @@
 #' @importFrom raster pointDistance
 #'
 slope_sinuosity <-function(channel_features, lead_n, lag_n,
-                           use_smoothing = TRUE,
+                           use_smoothing = FALSE,
                            loess_span = 0.5,
                            vert_units) {
   name <- deparse(substitute(channel_features))
@@ -134,9 +134,16 @@ slope_sinuosity <-function(channel_features, lead_n, lag_n,
     # Subset flowline_pts for the current reach
     fl_pts <- flowline_pts[flowline_pts$ReachName == r, ]
 
-    # Calculate a smoothed z (and convert to feet).
-    smooth_z <- loess(Z ~ POINT_M, data = fl_pts, span = loess_span)
-    fl_pts$Z_smooth <- predict(smooth_z) * vert_con_factor
+    if (use_smoothing == FALSE) {
+      # Copy z (and convert to feet).
+      fl_pts$Z_smooth <- fl_pts$Z * vert_con_factor
+    }
+    if (use_smoothing == TRUE) {
+      # Calculate a smoothed z (and convert to feet).
+      smooth_z_model <- loess(Z ~ POINT_M, data = fl_pts, span = loess_span)
+      fl_pts$Z_smooth <- predict(smooth_z_model) * vert_con_factor
+    }
+
 
     # Calculate variable mins and maxs (ensure units in feet).
     # Used as default to lead/lag to prevent NAs being introduced at ends
@@ -145,26 +152,14 @@ slope_sinuosity <-function(channel_features, lead_n, lag_n,
     downstream_m_lag        <- min(fl_pts$POINT_M) * 3280.48
     upstream_z_smooth_lead  <- max(fl_pts$Z_smooth)
     downstream_z_smooth_lag <- min(fl_pts$Z_smooth)
-    upstream_z_lead         <- max(fl_pts$Z) * vert_con_factor
-    downstream_z_lag        <- min(fl_pts$Z) * vert_con_factor
 
     # Calculate upstream/downstream z values (ensure units in feet)
-    if (use_smoothing == TRUE) {
-      fl_pts$upstream_z   <- lead(x = fl_pts$Z_smooth,
-                                  n = lead_n,
-                                  default = upstream_z_smooth_lead)
-      fl_pts$downstream_z <- lag(x = fl_pts$Z_smooth,
-                                 n = lag_n,
-                                 default = downstream_z_smooth_lag)
-    }
-    if (use_smoothing == FALSE) {
-      fl_pts$upstream_z   <- lead(x = fl_pts$Z * vert_con_factor,
-                                  n = lead_n,
-                                  default = upstream_z_lead)
-      fl_pts$downstream_z <- lag(x = fl_pts$Z * vert_con_factor,
-                                 n = lag_n,
-                                 default = downstream_z_lag)
-    }
+    fl_pts$upstream_z   <- lead(x = fl_pts$Z_smooth,
+                                n = lead_n,
+                                default = upstream_z_smooth_lead)
+    fl_pts$downstream_z <- lag(x = fl_pts$Z_smooth,
+                               n = lag_n,
+                               default = downstream_z_smooth_lag)
 
     # Calculate upstream/downstream m-values (ensure units in feet).
     fl_pts$upstream_m   <- lead(x = fl_pts$POINT_M * 3280.48,

diff --git a/R/stream_power.R b/R/stream_power.R
@@ -125,11 +125,13 @@ stream_power <- function(xs_dims,
   g <- 9.8
 
   # Discharge
+  num_xs = length(xs_dims$drainage_area)
   Q <- switch(discharge_method,
-              model_measure      = discharge_value,
-              regional_curve     = RegionalCurve::RHG(region,
-                                                      xs_dims$drainage_area,
-                                                      "discharge"),
+              model_measure  = discharge_value,
+              regional_curve = RegionalCurve::RHG(
+                                  region = rep(region, num_xs),
+                                  drainageArea = xs_dims$drainage_area,
+                                  dimensionType = rep("discharge", num_xs)),
               width_relationship = 0,
               stop("discharge_method parameter is specified incorrectly"))
 

diff --git a/R/xs_geometry.R b/R/xs_geometry.R
@@ -103,11 +103,12 @@ xs_geometry <- function(xs_points, detrend_elevation) {
   d1 <- f2(xs_stations)
   xs_width <- mean(diff(xs_stations)) * length(d1[d1 > 0])
 
-  # Calculate cross sectional max depth
-  xs_depth <- max(f1(xs_stations)[f1(xs_stations) > 0])
+  # Calculate cross sectional mean depth
+  xs_depth <- mean(f1(xs_stations)[f1(xs_stations) > 0])
 
-  # Check for missing max depth (-Inf). If so, set to zero
+  # Check for missing depth (-Inf, NaN). If so, set to zero
   if(is.infinite(xs_depth)) xs_depth <- 0
+  if(is.nan(xs_depth)) xs_depth <- 0
 
   # Set discharge (as a placeholder field for other functions)
   discharge <- 0

diff --git a/README.Rmd b/README.Rmd
@@ -14,7 +14,7 @@ An `R` Package for Performing **Fluv**ial **Geo**mrphology Analysis
 ## Package Status
 [![Maturing](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://www.tidyverse.org/lifecycle)
 [![Project Status: Active The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)
-[![packageversion](https://img.shields.io/badge/Package%20version-0.1.47-orange.svg?style=flat-square)](commits/master)
+[![packageversion](https://img.shields.io/badge/Package%20version-0.1.49-orange.svg?style=flat-square)](commits/master)
 [![Last-changedate](https://img.shields.io/badge/last%20change-`r gsub('-', '--', Sys.Date())`-yellowgreen.svg)](/commits/master)
 [![Licence](https://img.shields.io/badge/licence-CC0-blue.svg)](http://choosealicense.com/licenses/cc0-1.0/)
 

diff --git a/README.md b/README.md
@@ -14,7 +14,7 @@ An `R` Package for Performing **Fluv**ial **Geo**mrphology Analysis
 and is being actively
 developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)
 [![packageversion](https://img.shields.io/badge/Package%20version-0.1.47-orange.svg?style=flat-square)](commits/master)
-[![Last-changedate](https://img.shields.io/badge/last%20change-2023--08--29-yellowgreen.svg)](/commits/master)
+[![Last-changedate](https://img.shields.io/badge/last%20change-2024--04--02-yellowgreen.svg)](/commits/master)
 [![Licence](https://img.shields.io/badge/licence-CC0-blue.svg)](http://choosealicense.com/licenses/cc0-1.0/)
 
 ## Description

diff --git a/man/fluvgeo.Rd b/man/fluvgeo.Rd
diff --git a/man/slope_sinuosity.Rd b/man/slope_sinuosity.Rd
diff --git a/tests/testthat/test_slope_sinuosity.R b/tests/testthat/test_slope_sinuosity.R
@@ -17,6 +17,11 @@ sin_riffle_channel_ss <- slope_sinuosity(sin_riffle_channel_sf,
                                          loess_span = 0.5,
                                          vert_units = "ft")
 
+sin_fl_pts_ss_nosmooth <- slope_sinuosity(sin_fl_pts_sf,
+                                          lead_n = 50, lag_n = 50,
+                                          use_smoothing = FALSE,
+                                          vert_units = "ft")
+
 # Get feature class test data
 fl_pts_m_fc  <- file.path(system.file("extdata", "y2016_R1.gdb",
                                       package = "fluvgeo"),

diff --git a/tests/testthat/test_xs_geometry.R b/tests/testthat/test_xs_geometry.R
@@ -49,7 +49,7 @@ test_that("Check that output fields are of the correct data type", {
 
 test_that("Check dimensions from known stream", {
   expect_equal(sin_4$xs_width,    93.3, tolerance = 1e-2)
-  expect_equal(sin_4$xs_depth,    3.52, tolerance = 1e-2)
+  expect_equal(sin_4$xs_depth,    2.8, tolerance = 1e-2)
   expect_equal(sin_4$xs_area,     259.4, tolerance = 1e-2)
   expect_equal(sin_4$discharge,     0.0, tolerance = 1e-2)
   expect_equal(sin_4$ground_elev, 645.7, tolerance = 1e-2)

diff --git a/tests/testthat/test_xs_metrics.R b/tests/testthat/test_xs_metrics.R
@@ -130,11 +130,11 @@ test_that("Check dimensions from known stream", {
   expect_equal(sin_4$drainage_area,         40.27, tolerance = 1e-2)
   expect_equal(sin_4$xs_area,               323.2, tolerance = 1e-2)
   expect_equal(sin_4$xs_width,              129.2, tolerance = 1e-2)
-  expect_equal(sin_4$xs_depth,              4.17, tolerance = 1e-2)
+  expect_equal(sin_4$xs_depth,              2.72, tolerance = 1e-2)
   expect_equal(sin_4$discharge,             0.0, tolerance = 1e-2)
   expect_equal(sin_4$fp_area,               983.9, tolerance = 1e-2)
   expect_equal(sin_4$fp_width,              486.2, tolerance = 1e-2)
-  expect_equal(sin_4$fp_depth,              7.67, tolerance = 1e-2)
+  expect_equal(sin_4$fp_depth,              2.17, tolerance = 1e-2)
   # expect_equal(sin_4$xs_width_depth_ratio,  30.98, tolerance = 1e-2)
   expect_equal(sin_4$xs_entrenchment_ratio, 3.76, tolerance = 1e-2)
   expect_equal(sin_4$watersurface_elev,     641.51, tolerance = 1e-2)

diff --git a/tests/testthat/test_xs_regional_metrics.R b/tests/testthat/test_xs_regional_metrics.R
@@ -103,7 +103,7 @@ test_that("Check dimensions from known stream", {
   expect_equal(sin_4_xs$drainage_area,         40.27, tolerance = 1e-2)
   expect_equal(sin_4_xs$xs_area,               259.45, tolerance = 1e-2)
   expect_equal(sin_4_xs$xs_width,              93.32, tolerance = 1e-2)
-  expect_equal(sin_4_xs$xs_depth,              3.53, tolerance = 1e-2)
+  expect_equal(sin_4_xs$xs_depth,              2.8, tolerance = 1e-2)
   expect_equal(sin_4_xs$discharge,             0.0, tolerance = 1e-2)
 })