feat: singular section definitions in create_section_txt and create_uniform_reach_txt

Refs #19

R/create_section_txt.R

@@ -5,6 +5,7 @@
 #' @param section_type 1-length [character], type of the section: "T" for Trapezoidal, "A" for Abscissa/Elevation, "L" for Width/Elevation
 #' @param profile [list] or [matrix], profile of the section (See details)
 #' @param distance_majeur [logical] or [numeric], `FALSE` for a minor bed section
+#' @param singular [logical] `TRUE` for a singular section, `FALSE` for a regular section
 #'
 #' @return [character], section description in SIC text import format.
 #' @export
@@ -12,7 +13,12 @@
 #' @examples
 #' # Trapezoidal section
 #' create_section_txt("Trapeze", 0, "T", list(B = 2, S = 1.5, ZF = 100, ZB = 102))
-create_section_txt <- function(section_name, abscissa, section_type, profile, distance_majeur = FALSE) {
+create_section_txt <- function(section_name,
+                               abscissa,
+                               section_type,
+                               profile,
+                               distance_majeur = FALSE,
+                               singular = FALSE) {
 
   if (section_type == "T") {
     if (!is.list(profile) || !all(c("B", "S", "ZF", "ZB") %in% names(profile))) {
@@ -36,7 +42,7 @@ create_section_txt <- function(section_name, abscissa, section_type, profile, di
           abscissa,
           ifelse(bMajorBed, distance_majeur, ""),
           ifelse(bMajorBed, "1", "0"),
-          section_type,
+          paste0(section_type, ifelse(singular, "S", "")),
           sep = " $ "),
     sic_profile)
   class(section_txt) <- c("SectionTxt", class(section_txt))

R/create_uniform_reach_txt.R

@@ -4,8 +4,14 @@
 #' @param upstream_bed_elevation [numeric], upstream bed elevation (m)
 #' @param slope [numeric], bed slope of the reach (m/m)
 #' @param section_names [character] vector of section names
+#' @param singular [numeric] vector of abscissas of singular sections (See details)
 #' @inheritParams create_section_txt
 #'
+#' @details
+#' The abscissas of the `singular` parameter should match with sections
+#' abscissas defined by `abscissas`. `singular` values that don't match are silently
+#' ignored.
+#'
 #' @return A [list] from which each item is a section exported by [create_section_txt].
 #' Names of the list are the abscissas with trailing zeros for character sorting.
 #' @export
@@ -25,7 +31,11 @@ create_uniform_reach_txt <- function(abscissas,
                                      slope,
                                      section_type,
                                      profile,
-                                     section_names = paste0("Section x=", abscissas)) {
+                                     section_names = paste0("Section x=", abscissas),
+                                     singular = NULL) {
+  if (!is.null(singular)) {
+    stopifnot(is.vector(singular), is.numeric(singular))
+  }
 
   sections <- lapply(seq_along(abscissas), function(i) {
     x <- abscissas[i]
@@ -34,7 +44,8 @@ create_uniform_reach_txt <- function(abscissas,
     create_section_txt(section_name = section_names[i],
                        abscissa = x,
                        section_type = section_type,
-                       profile = shifted_prof)
+                       profile = shifted_prof,
+                       singular = any(abs(singular - x) < 0.001))
   })
   names(sections) <- sprintf("%08d", abscissas)
   class(sections) <- c("ReachTxt", class(sections))

man/create_section_txt.Rd

@@ -9,7 +9,8 @@ create_section_txt(
   abscissa,
   section_type,
   profile,
-  distance_majeur = FALSE
+  distance_majeur = FALSE,
+  singular = FALSE
 )
 }
 \arguments{
@@ -22,6 +23,8 @@ create_section_txt(
 \item{profile}{\link{list} or \link{matrix}, profile of the section (See details)}
 
 \item{distance_majeur}{\link{logical} or \link{numeric}, \code{FALSE} for a minor bed section}
+
+\item{singular}{\link{logical} \code{TRUE} for a singular section, \code{FALSE} for a regular section}
 }
 \value{
 \link{character}, section description in SIC text import format.

man/create_uniform_reach_txt.Rd

@@ -10,7 +10,8 @@ create_uniform_reach_txt(
   slope,
   section_type,
   profile,
-  section_names = paste0("Section x=", abscissas)
+  section_names = paste0("Section x=", abscissas),
+  singular = NULL
 )
 }
 \arguments{
@@ -25,6 +26,8 @@ create_uniform_reach_txt(
 \item{profile}{\link{list} or \link{matrix}, profile of the section (See details)}
 
 \item{section_names}{\link{character} vector of section names}
+
+\item{singular}{\link{logical} \code{TRUE} for a singular section, \code{FALSE} for a regular section}
 }
 \value{
 A \link{list} from which each item is a section exported by \link{create_section_txt}.

tests/testthat/test-create_section_txt.R

@@ -5,7 +5,7 @@ profT <- list(
   ZB = 100 + 2
 )
 
-test_that("Trapezoidale minor section", {
+test_that("Trapezoidal minor section", {
   expect_equal(
     unclass(create_section_txt("toto", 1000, "T", profT, distance_majeur = FALSE)),
     c("toto $ 1000 $  $ 0 $ T", "0", "2\t1", "102\t100")
@@ -17,6 +17,13 @@ test_that("Trapezoidale minor section", {
   )
 })
 
+test_that("Singular section", {
+  expect_equal(
+    unclass(create_section_txt("toto", 1000, "T", profT, distance_majeur = FALSE, singular = TRUE)),
+    c("toto $ 1000 $  $ 0 $ TS", "0", "2\t1", "102\t100")
+  )
+})
+
 test_that("X/Z minor section", {
   expect_error(
     create_section_txt("toto", 1000, "A", profT, distance_majeur = FALSE)

tests/testthat/test-create_uniform_reach_txt.R

@@ -14,10 +14,11 @@ test_that("Trapezoidal minor section", {
                              upstream_bed_elevation = 100,
                              slope = 0.001,
                              section_type = "T",
-                             profile = profT)[1:2],
+                             profile = profT,
+                             singular = 2000)[1:2],
     list(
       "00001000" = create_section_txt("Section x=1000", 1000, "T", profT),
-      "00002000" = create_section_txt("Section x=2000", 2000, "T", profT2)
+      "00002000" = create_section_txt("Section x=2000", 2000, "T", profT2, singular = TRUE)
     )
   )
 })

tests/testthat/test-sic_import_reaches.R

@@ -8,7 +8,8 @@ min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100),
                                       upstream_bed_elevation = 8 + 10000 * 0.002,
                                       slope = 0.002,
                                       section_type = "L",
-                                      profile = profT)
+                                      profile = profT,
+                                      singular = c(2500, 7500))
 
 # Major bed generation
 data("floodam_ead_dem")