diff --git a/R/create_section_txt.R b/R/create_section_txt.R
index ac164f4613a9deaaf1f5887db8474311fdc5c481..4187904a9f88dacd3565bc95669377d4db64115a 100644
--- a/R/create_section_txt.R
+++ b/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))
diff --git a/R/create_uniform_reach_txt.R b/R/create_uniform_reach_txt.R
index f003d0aab5cb74e9c4cafb0dfb70cb0031180886..f0af5f8db1054b5ad2a2860e80ba1eba762c9a53 100644
--- a/R/create_uniform_reach_txt.R
+++ b/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))
diff --git a/man/create_section_txt.Rd b/man/create_section_txt.Rd
index eecc674e690e2eb823d5a955191a8cfe436ede8a..00580b037fbdf283acd15ecf9d9a3ef3ac2597bb 100644
--- a/man/create_section_txt.Rd
+++ b/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.
diff --git a/man/create_uniform_reach_txt.Rd b/man/create_uniform_reach_txt.Rd
index 64040f86eb3c7a2ba93a99573081a8a5eeab5f1a..da7c02fc2cc814db1ea343961259707b60dbc428 100644
--- a/man/create_uniform_reach_txt.Rd
+++ b/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}.
diff --git a/tests/testthat/test-create_section_txt.R b/tests/testthat/test-create_section_txt.R
index aef1a0c2457bd2af4f224f5e057a6f33aa4d2ef0..205fa39f3d2efbcbd09bee5364511a7dce72fb27 100644
--- a/tests/testthat/test-create_section_txt.R
+++ b/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)
diff --git a/tests/testthat/test-create_uniform_reach_txt.R b/tests/testthat/test-create_uniform_reach_txt.R
index 62a8c12785421b8ee16bd432599cf6921c53ee41..5f077144b8fc2006f5c7e154257cd1be45d3819b 100644
--- a/tests/testthat/test-create_uniform_reach_txt.R
+++ b/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)
)
)
})
diff --git a/tests/testthat/test-sic_import_reaches.R b/tests/testthat/test-sic_import_reaches.R
index 56d20c2be99bbd8c6368725ecf0045c93b15d1ee..5e065db7cf262c28de61d027387ebb4ec6f9f2dd 100644
--- a/tests/testthat/test-sic_import_reaches.R
+++ b/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")