From b76adcdec461459c7a75b78dcba64c7ea07d04c7 Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@irstea.fr>
Date: Thu, 7 Apr 2022 14:05:10 +0200
Subject: [PATCH] feat: singular section definitions in create_section_txt and
create_uniform_reach_txt
Refs #19
---
R/create_section_txt.R | 10 ++++++++--
R/create_uniform_reach_txt.R | 15 +++++++++++++--
man/create_section_txt.Rd | 5 ++++-
man/create_uniform_reach_txt.Rd | 5 ++++-
tests/testthat/test-create_section_txt.R | 9 ++++++++-
tests/testthat/test-create_uniform_reach_txt.R | 5 +++--
tests/testthat/test-sic_import_reaches.R | 3 ++-
7 files changed, 42 insertions(+), 10 deletions(-)
diff --git a/R/create_section_txt.R b/R/create_section_txt.R
index ac164f4..4187904 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 f003d0a..f0af5f8 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 eecc674..00580b0 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 64040f8..da7c02f 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 aef1a0c..205fa39 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 62a8c12..5f07714 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 56d20c2..5e065db 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")
--
GitLab