R/stream_elev_from_slope.R

In scantle/pbjr: Modflow-USG Polyline Boundary Junction (PBJ) R Package

#' Calculate streambed elevations given geometry & slope
#' Assumes a single stream, with segments properly ordered.
#'
#' @param swdf DataFrame/Geometry of node barycentric coordinates as returned by
#'   \code{\link{calc_stream_voronoi_weights}}
#' @param slope numeric, streambed slope
#' @param initial_elev streambed elevation at start of segment 1
#'
#' @return swdf DataFrame/Geometry with added seg1.elev and seg2.elev columns
#' @author Leland Scantlebury
#' @export stream_elev_from_slope
#'
#' @examples
#' #-- Read in shapefiles
#' str <- read_sf(system.file("extdata", "MehlandHill2010_stream.shp", package = "pbjr"))
#' tri <- read_sf(system.file("extdata", "720_triangles.shp", package = "pbjr"))
#' vor <- read_sf(system.file("extdata", "720_voronoi.shp", package = "pbjr"))
#' str <- line_explode(str)
#'
#' #-- Calculate barycentric weight DF
#' swdf <- calc_stream_voronoi_weights(stream = str, voronoi = vor, triangles = tri)
#'
#' #-- Calculate distances
#' swdf <- stream_elev_from_slope(swdf = swdf, slope = 0.0015, initial_elev = 50)
#'
#' #-- Calculate conductances
#' swdf$Conductance <- calc_conductance_modflow(swdf, k_streambed = 1,
#'                                              str_width = 1, thickness = 0.5)
stream_elev_from_slope <- function(swdf, slope, initial_elev, order_by_index=F, sp=1) {

  #-- Order to index (if generated by calc_stream_voronoi_weights, order will be correct)
  if (order_by_index) {
    swdf <- swdf[order(swdf$index), ]
  }

  #-- Calculate a cumulative Length (distance from start)
  swdf$Distance <- cumsum(swdf$Length)

  if('Node1' %in% colnames(swdf)) {

    #-- Calculate upstream coordinate elevation
    swdf$seg1.elev <- initial_elev - (swdf$Distance - swdf$Length) * slope

    #-- Calculate downstream coordination elevation
    swdf$seg2.elev <- initial_elev - swdf$Distance * slope

  } else {
    # Newer naming convention
    elev_cols <- paste0(c('elev_a','elev_b'),sp)
    swdf[elev_cols[1]] <- initial_elev - (swdf$Distance - swdf$Length) * slope
    swdf[elev_cols[2]] <- initial_elev - swdf$Distance * slope
  }

  return(swdf)
}