From 0ac4ba1a53716f717f114e668809c37578924e3c Mon Sep 17 00:00:00 2001
From: hillarymarler <152432687+hillarymarler@users.noreply.github.com>
Date: Mon, 27 Apr 2026 14:54:14 -0400
Subject: [PATCH 01/23] Update DepthProfile.R
---
R/DepthProfile.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 1a0e9d442..457a78e43 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -1668,7 +1668,7 @@ TADA_DepthProfilePlot <- function(
paste0(
param1$TADA.ResultMeasureValue,
" ",
- param3$TADA.ResultMeasure.MeasureUnitCode
+ param1$TADA.ResultMeasure.MeasureUnitCode
),
"
",
"Activity Start Date:",
From d1128d8e8176fcf1e5a7c37320012ddfd87c3ae6 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Mon, 27 Apr 2026 17:43:13 -0400
Subject: [PATCH 02/23] dontrun service calls in examples
---
R/Utilities.R | 2 ++
man/TADA_RenametoLegacy.Rd | 2 ++
2 files changed, 4 insertions(+)
diff --git a/R/Utilities.R b/R/Utilities.R
index 57dd8dccb..92888e47a 100644
--- a/R/Utilities.R
+++ b/R/Utilities.R
@@ -2175,6 +2175,7 @@ TADA_CreateCSV <- function(.data) {
#' @export
#'
#' @examples
+#' \dontrun{
#' DeWitt_wqx3 <- dataRetrieval::readWQPdata(
#' statecode = "Illinois",
#' countycode = "DeWitt", characteristicName = "Nitrogen",
@@ -2183,6 +2184,7 @@ TADA_CreateCSV <- function(.data) {
#' )
#'
#' DeWitt_wqx3_withlegacynames <- EPATADA::TADA_RenametoLegacy(DeWitt_wqx3)
+#' }
#'
TADA_RenametoLegacy <- function(.data) {
## READ WQX3.0 column name schema from EPA Water Data WQP Quick Reference Guide
diff --git a/man/TADA_RenametoLegacy.Rd b/man/TADA_RenametoLegacy.Rd
index 523fc41b4..3875e9dc7 100644
--- a/man/TADA_RenametoLegacy.Rd
+++ b/man/TADA_RenametoLegacy.Rd
@@ -26,6 +26,7 @@ The function uses data.table::setnames() to rename columns in the dataframe
by reference - in this case where there are beta names, rename to legacy names, and skip where there are no matches.
}
\examples{
+\dontrun{
DeWitt_wqx3 <- dataRetrieval::readWQPdata(
statecode = "Illinois",
countycode = "DeWitt", characteristicName = "Nitrogen",
@@ -34,5 +35,6 @@ DeWitt_wqx3 <- dataRetrieval::readWQPdata(
)
DeWitt_wqx3_withlegacynames <- EPATADA::TADA_RenametoLegacy(DeWitt_wqx3)
+}
}
From 08c1c33978fcd05e32c5f76f1002cecbf4854e23 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Mon, 27 Apr 2026 18:36:59 -0400
Subject: [PATCH 03/23] Address issues in DepthProfile.R
---
R/DepthProfile.R | 97 ++++++++++++++++++------------------------------
1 file changed, 37 insertions(+), 60 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 457a78e43..08f5cf07c 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -102,11 +102,13 @@ TADA_FlagDepthCategory <- function(
expected_cols <- c(
"TADA.ActivityDepthHeightMeasure.MeasureValue",
"TADA.ResultDepthHeightMeasure.MeasureValue",
+ "TADA.ActivityBottomDepthHeightMeasure.MeasureValue",
"ActivityRelativeDepthName",
"TADA.ResultDepthHeightMeasure.MeasureUnitCode",
"TADA.ActivityDepthHeightMeasure.MeasureUnitCode",
"TADA.CharacteristicName",
"TADA.ResultMeasure.MeasureUnitCode",
+ "TADA.ResultMeasureValue",
"ResultIdentifier",
"TADA.MonitoringLocationIdentifier",
"OrganizationIdentifier",
@@ -668,7 +670,8 @@ TADA_IDDepthProfiles <- function(
flag.func.cols <- c(
"TADA.ConsolidatedDepth",
"TADA.ConsolidatedDepth.Unit",
- "TADA.ConsolidatedDepth.Bottom, TADA.DepthCategory.Flag",
+ "TADA.ConsolidatedDepth.Bottom",
+ "TADA.DepthCategory.Flag",
"TADA.DepthProfileAggregation.Flag"
)
@@ -939,16 +942,10 @@ TADA_DepthProfilePlot <- function(
unit = "m"
) {
# check to see if TADA.ComparableDataIdentifier column is present
- if ("TADA.ComparableDataIdentifier" %in% colnames(.data)) {
- .data <- .data
-
- if (!"TADA.ComparableDataIdentifier" %in% colnames(.data)) {
- message(
- "TADA.ComparableDataIdentifier column not present in data set. Run TADA_CreateComparableID to create TADA.ComparableDataIdentifier."
- )
-
- stop()
- }
+ if (!"TADA.ComparableDataIdentifier" %in% colnames(.data)) {
+ stop(
+ "TADA.ComparableDataIdentifier column not present in data set. Run TADA_CreateComparableID to create TADA.ComparableDataIdentifier."
+ )
}
# check .data is data.frame
@@ -958,7 +955,8 @@ TADA_DepthProfilePlot <- function(
flag.func.cols <- c(
"TADA.ConsolidatedDepth",
"TADA.ConsolidatedDepth.Unit",
- "TADA.ConsolidatedDepth.Bottom, TADA.DepthCategory.Flag"
+ "TADA.ConsolidatedDepth.Bottom",
+ "TADA.DepthCategory.Flag"
)
if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
@@ -988,14 +986,13 @@ TADA_DepthProfilePlot <- function(
.data,
surfacevalue = 2,
bottomvalue = bottomvalue
- ) |>
- dplyr::mutate(
- TADA.DepthCatgeory.Flag = ifelse(
- TADA.DepthCategory.Flag %in% c("Surface", "Middle"),
- NA,
- TADA.DepthCategory.Flag
- )
+ ) |> dplyr::mutate(
+ TADA.DepthCategory.Flag = ifelse(
+ TADA.DepthCategory.Flag %in% c("Surface", "Middle"),
+ NA,
+ TADA.DepthCategory.Flag
)
+ )
}
if (bottomvalue == "null" & is.numeric(surfacevalue)) {
@@ -1003,14 +1000,13 @@ TADA_DepthProfilePlot <- function(
.data,
surfacevalue = surfacevalue,
bottomvalue = 2
- ) |>
- dplyr::mutate(
- TADA.DepthCatgeory.Flag = ifelse(
- TADA.DepthCategory.Flag %in% c("Bottom", "Middle"),
- NA,
- TADA.DepthCategory.Flag
- )
+ ) |> dplyr::mutate(
+ TADA.DepthCategory.Flag = ifelse(
+ TADA.DepthCategory.Flag %in% c("Bottom", "Middle"),
+ NA,
+ TADA.DepthCategory.Flag
)
+ )
}
if (is.numeric(bottomvalue) & is.numeric(surfacevalue)) {
@@ -1029,14 +1025,10 @@ TADA_DepthProfilePlot <- function(
message(
"TADA_DepthProfilePlot: Depth unit in data set matches depth unit specified by user for plot. No conversion necessary."
)
-
- .data <- .data
-
- if (.data$TADA.ConsolidatedDepth.Unit[1] != unit) {
- stop(
- "TADA_DepthProfilePlot: Depth unit in data set does not match depth unit specified by user for plot. Convert units in data or specify correct unit in TADA_DepthProfilePlot function."
- )
- }
+ } else {
+ stop(
+ "TADA_DepthProfilePlot: Depth unit in data set does not match depth unit specified by user for plot. Convert units in data or specify correct unit in TADA_DepthProfilePlot function."
+ )
}
# create ID Depth Profiles data.frame to check against params
@@ -1214,7 +1206,9 @@ TADA_DepthProfilePlot <- function(
"ActivityStartDateTime",
"TADA.ConsolidatedDepth",
"TADA.ConsolidatedDepth.Unit",
- "TADA.ConsolidatedDepth.Bottom"
+ "TADA.ConsolidatedDepth.Bottom",
+ "TADA.ActivityMediaName",
+ "TADA.ComparableDataIdentifier"
)
# check .data has required columns
@@ -1278,8 +1272,7 @@ TADA_DepthProfilePlot <- function(
# if any depth parameter (ex: secchi) data
if (length(intersect(groups, depth.params.groups)) == 0) {
- depth.params.string <- toString(depth.params, sep = "; ") |>
- stringi::stri_replace_last(" or ", fixed = "; ")
+ depth.params.string <- paste(depth.params, collapse = "; ")
profile.data <- depthprofile.avail
@@ -1288,8 +1281,7 @@ TADA_DepthProfilePlot <- function(
if (length(intersect(groups, depth.params.groups)) > 0) {
# add depth param (ex: secchi) results
- depth.params.string <- toString(depth.params, sep = "; ") |>
- stringi::stri_replace_last(" or ", fixed = "; ")
+ depth.params.string <- paste(depth.params, collapse = "; ")
depth.units <- c(
"m",
@@ -1417,18 +1409,14 @@ TADA_DepthProfilePlot <- function(
}
}
- profile.data <- depthprofile.avail |>
- dplyr::full_join(depth.params.avail, by = c(names(depthprofile.avail)))
+ profile.data <- dplyr::bind_rows(depthprofile.avail, depth.params.avail)
rm(depth.params.avail, depthprofile.avail)
}
# this subset must include all fields included in plot hover below
plot.data <- profile.data |>
- dplyr::filter(dplyr::if_any(
- TADA.ComparableDataIdentifier,
- ~ .x %in% groups
- )) |>
+ dplyr::filter(TADA.ComparableDataIdentifier %in% groups) |>
dplyr::select(
dplyr::all_of(required_cols),
"TADA.ComparableDataIdentifier",
@@ -1453,22 +1441,11 @@ TADA_DepthProfilePlot <- function(
# break into subsets for each parameter
param1 <- plot.data |>
- dplyr::filter(dplyr::if_any(
- TADA.ComparableDataIdentifier,
- ~ .x %in% groups[1]
- ))
-
+ dplyr::filter(TADA.ComparableDataIdentifier %in% groups[1])
param2 <- plot.data |>
- dplyr::filter(dplyr::if_any(
- TADA.ComparableDataIdentifier,
- ~ .x %in% groups[2]
- ))
-
+ dplyr::filter(TADA.ComparableDataIdentifier %in% groups[2])
param3 <- plot.data |>
- dplyr::filter(dplyr::if_any(
- TADA.ComparableDataIdentifier,
- ~ .x %in% groups[3]
- ))
+ dplyr::filter(TADA.ComparableDataIdentifier %in% groups[3])
# create title for figure, conditional on number of groups/characteristics selected
@@ -1830,7 +1807,7 @@ TADA_DepthProfilePlot <- function(
paste0(
param3$TADA.ResultMeasureValue,
" ",
- param2$TADA.ResultMeasure.MeasureUnitCode
+ param3$TADA.ResultMeasure.MeasureUnitCode
),
"
",
"Activity Start Date:",
From 7a02690423851076b81026b1476a9dd7d8ce2aa0 Mon Sep 17 00:00:00 2001
From: "pre-commit-ci[bot]"
<66853113+pre-commit-ci[bot]@users.noreply.github.com>
Date: Mon, 27 Apr 2026 22:37:12 +0000
Subject: [PATCH 04/23] [pre-commit.ci] auto fixes from pre-commit.com hooks
for more information, see https://pre-commit.ci
---
R/DepthProfile.R | 26 ++++++++++++++------------
1 file changed, 14 insertions(+), 12 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 08f5cf07c..036bb6cfd 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -986,13 +986,14 @@ TADA_DepthProfilePlot <- function(
.data,
surfacevalue = 2,
bottomvalue = bottomvalue
- ) |> dplyr::mutate(
- TADA.DepthCategory.Flag = ifelse(
- TADA.DepthCategory.Flag %in% c("Surface", "Middle"),
- NA,
- TADA.DepthCategory.Flag
+ ) |>
+ dplyr::mutate(
+ TADA.DepthCategory.Flag = ifelse(
+ TADA.DepthCategory.Flag %in% c("Surface", "Middle"),
+ NA,
+ TADA.DepthCategory.Flag
+ )
)
- )
}
if (bottomvalue == "null" & is.numeric(surfacevalue)) {
@@ -1000,13 +1001,14 @@ TADA_DepthProfilePlot <- function(
.data,
surfacevalue = surfacevalue,
bottomvalue = 2
- ) |> dplyr::mutate(
- TADA.DepthCategory.Flag = ifelse(
- TADA.DepthCategory.Flag %in% c("Bottom", "Middle"),
- NA,
- TADA.DepthCategory.Flag
+ ) |>
+ dplyr::mutate(
+ TADA.DepthCategory.Flag = ifelse(
+ TADA.DepthCategory.Flag %in% c("Bottom", "Middle"),
+ NA,
+ TADA.DepthCategory.Flag
+ )
)
- )
}
if (is.numeric(bottomvalue) & is.numeric(surfacevalue)) {
From 011217fc545f5074226f00c7335f1f0b0dfa6a29 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 08:56:16 -0400
Subject: [PATCH 05/23] Address bugs
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
surfacevalue or bottomvalue as NULL or "null" are treated as NA; only the categories that can be determined are assigned.
If both are NA, the function won’t assign Surface/Middle/Bottom by thresholds but can still fall back to ActivityRelativeDepthName via ARD ref; otherwise “No depth info” is used where appropriate.
Ensures depth units are single/consistent and errors otherwise (so you fail fast if upstream unit conversion was missed).
---
R/DepthProfile.R | 74 +++++++++++++++++++++++++++++++++++++-----------
1 file changed, 57 insertions(+), 17 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 036bb6cfd..d7063b904 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -119,6 +119,20 @@ TADA_FlagDepthCategory <- function(
TADA_CheckType(aggregatedonly, "logical")
# check clean is boolean
TADA_CheckType(clean, "logical")
+
+ # normalize 'null' and NULL inputs to NA_real_
+ if (is.character(surfacevalue) && tolower(surfacevalue) == "null") surfacevalue <- NA_real_
+ if (is.character(bottomvalue) && tolower(bottomvalue) == "null") bottomvalue <- NA_real_
+ if (is.null(surfacevalue)) surfacevalue <- NA_real_
+ if (is.null(bottomvalue)) bottomvalue <- NA_real_
+
+ # validate types if provided
+ if (!is.na(surfacevalue) && !is.numeric(surfacevalue)) {
+ stop("TADA_FlagDepthCategory: surfacevalue must be numeric, NULL, or 'null'.")
+ }
+ if (!is.na(bottomvalue) && !is.numeric(bottomvalue)) {
+ stop("TADA_FlagDepthCategory: bottomvalue must be numeric, NULL, or 'null'.")
+ }
# execute function after checks are passed
@@ -186,9 +200,10 @@ TADA_FlagDepthCategory <- function(
message("TADA_FlagDepthCategory: assigning depth categories.")
+ # 1) Consolidate depth and units first
.data <- .data |>
- # set equal to TADA.ResultDepthHeighMeasure.MeasureValue if available, otherwise use TADA.ActivityDepthHeightMeasure.MeasureValue
dplyr::mutate(
+ # set equal to TADA.ResultDepthHeighMeasure.MeasureValue if available, otherwise use TADA.ActivityDepthHeightMeasure.MeasureValue
TADA.ConsolidatedDepth = ifelse(
!is.na(TADA.ResultDepthHeightMeasure.MeasureValue),
TADA.ResultDepthHeightMeasure.MeasureValue,
@@ -199,6 +214,7 @@ TADA_FlagDepthCategory <- function(
TADA.ResultDepthHeightMeasure.MeasureUnitCode,
TADA.ActivityDepthHeightMeasure.MeasureUnitCode
),
+ # Override with ResultMeasureValue for depth-parameter characteristics
TADA.ConsolidatedDepth = ifelse(
TADA.CharacteristicName %in% depth.params,
TADA.ResultMeasureValue,
@@ -210,8 +226,21 @@ TADA_FlagDepthCategory <- function(
TADA.ConsolidatedDepth.Unit
),
TADA.ConsolidatedDepth.Unit = tolower(TADA.ConsolidatedDepth.Unit)
- ) |>
- # use group_by to identify profile data
+ )
+
+ # 2) Validate there is only one depth unit in use (assumes conversion already done)
+ units_present <- .data |>
+ dplyr::filter(!is.na(TADA.ConsolidatedDepth.Unit)) |>
+ dplyr::pull(TADA.ConsolidatedDepth.Unit) |>
+ unique()
+
+ if (length(units_present) > 1) {
+ stop("TADA_FlagDepthCategory: Multiple depth units detected. Convert depth units to a single unit before categorizing.")
+ }
+
+ # 3) Proceed to compute bottom depth and assign categories (NA-aware)
+ # use group_by to identify profile data
+ .data <- .data |>
dplyr::group_by(
ActivityStartDate,
TADA.MonitoringLocationIdentifier,
@@ -229,25 +258,36 @@ TADA_FlagDepthCategory <- function(
)
) |>
dplyr::ungroup() |>
- # assign depth categories by using depth information
dplyr::mutate(
+ # Only assign depth categories when the needed thresholds are available
TADA.DepthCategory.Flag = dplyr::case_when(
- TADA.ConsolidatedDepth <= surfacevalue ~ "Surface",
- TADA.ConsolidatedDepth <= TADA.ConsolidatedDepth.Bottom &
- TADA.ConsolidatedDepth >=
- TADA.ConsolidatedDepth.Bottom - bottomvalue ~ "Bottom",
- TADA.ConsolidatedDepth > surfacevalue &
- TADA.ConsolidatedDepth <
- TADA.ConsolidatedDepth.Bottom - bottomvalue ~ "Middle"
+ # Surface only if surfacevalue is provided
+ !is.na(surfacevalue) &
+ !is.na(TADA.ConsolidatedDepth) &
+ TADA.ConsolidatedDepth <= surfacevalue ~ "Surface",
+
+ # Bottom only if bottomvalue and bottom depth are available
+ !is.na(bottomvalue) &
+ !is.na(TADA.ConsolidatedDepth.Bottom) &
+ !is.na(TADA.ConsolidatedDepth) &
+ TADA.ConsolidatedDepth >= (TADA.ConsolidatedDepth.Bottom - bottomvalue) &
+ TADA.ConsolidatedDepth <= TADA.ConsolidatedDepth.Bottom ~ "Bottom",
+
+ # Middle only if both surfacevalue and bottomvalue are provided (and bottom available)
+ !is.na(surfacevalue) & !is.na(bottomvalue) &
+ !is.na(TADA.ConsolidatedDepth.Bottom) &
+ !is.na(TADA.ConsolidatedDepth) &
+ TADA.ConsolidatedDepth > surfacevalue &
+ TADA.ConsolidatedDepth < (TADA.ConsolidatedDepth.Bottom - bottomvalue) ~ "Middle",
+
+ TRUE ~ NA_character_
)
) |>
- # assign depth categories that could not be assigned using depth
+ # Join ARD reference as fallback
dplyr::left_join(ard.ref, by = "ActivityRelativeDepthName") |>
dplyr::mutate(
TADA.DepthCategory.Flag = ifelse(
- is.na(TADA.DepthCategory.Flag),
- ARD_Category,
- TADA.DepthCategory.Flag
+ is.na(TADA.DepthCategory.Flag), ARD_Category, TADA.DepthCategory.Flag
),
TADA.DepthCategory.Flag = ifelse(
is.na(TADA.ActivityDepthHeightMeasure.MeasureValue) &
@@ -375,7 +415,7 @@ TADA_FlagDepthCategory <- function(
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
- "No aggregation perfomed",
+ "No aggregation performed",
"No aggregation needed"
)
) |>
@@ -385,7 +425,7 @@ TADA_FlagDepthCategory <- function(
if (aggregatedonly == TRUE) {
stop(
- "Function not executed because clean cannot be TRUE while daily_agg is 'no'"
+ "aggregatedonly = TRUE requires dailyagg = 'avg', 'min' or 'max'; nothing to return when dailyagg = 'none'."
)
}
From 85c001b101676177877a08aba9d9b0fb6eae0db2 Mon Sep 17 00:00:00 2001
From: "pre-commit-ci[bot]"
<66853113+pre-commit-ci[bot]@users.noreply.github.com>
Date: Tue, 28 Apr 2026 12:56:49 +0000
Subject: [PATCH 06/23] [pre-commit.ci] auto fixes from pre-commit.com hooks
for more information, see https://pre-commit.ci
---
R/DepthProfile.R | 57 ++++++++++++++++++++++++++++++++----------------
1 file changed, 38 insertions(+), 19 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index d7063b904..8eb01b1e9 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -119,19 +119,31 @@ TADA_FlagDepthCategory <- function(
TADA_CheckType(aggregatedonly, "logical")
# check clean is boolean
TADA_CheckType(clean, "logical")
-
+
# normalize 'null' and NULL inputs to NA_real_
- if (is.character(surfacevalue) && tolower(surfacevalue) == "null") surfacevalue <- NA_real_
- if (is.character(bottomvalue) && tolower(bottomvalue) == "null") bottomvalue <- NA_real_
- if (is.null(surfacevalue)) surfacevalue <- NA_real_
- if (is.null(bottomvalue)) bottomvalue <- NA_real_
-
+ if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
+ surfacevalue <- NA_real_
+ }
+ if (is.character(bottomvalue) && tolower(bottomvalue) == "null") {
+ bottomvalue <- NA_real_
+ }
+ if (is.null(surfacevalue)) {
+ surfacevalue <- NA_real_
+ }
+ if (is.null(bottomvalue)) {
+ bottomvalue <- NA_real_
+ }
+
# validate types if provided
if (!is.na(surfacevalue) && !is.numeric(surfacevalue)) {
- stop("TADA_FlagDepthCategory: surfacevalue must be numeric, NULL, or 'null'.")
+ stop(
+ "TADA_FlagDepthCategory: surfacevalue must be numeric, NULL, or 'null'."
+ )
}
if (!is.na(bottomvalue) && !is.numeric(bottomvalue)) {
- stop("TADA_FlagDepthCategory: bottomvalue must be numeric, NULL, or 'null'.")
+ stop(
+ "TADA_FlagDepthCategory: bottomvalue must be numeric, NULL, or 'null'."
+ )
}
# execute function after checks are passed
@@ -227,17 +239,19 @@ TADA_FlagDepthCategory <- function(
),
TADA.ConsolidatedDepth.Unit = tolower(TADA.ConsolidatedDepth.Unit)
)
-
+
# 2) Validate there is only one depth unit in use (assumes conversion already done)
units_present <- .data |>
dplyr::filter(!is.na(TADA.ConsolidatedDepth.Unit)) |>
dplyr::pull(TADA.ConsolidatedDepth.Unit) |>
unique()
-
+
if (length(units_present) > 1) {
- stop("TADA_FlagDepthCategory: Multiple depth units detected. Convert depth units to a single unit before categorizing.")
+ stop(
+ "TADA_FlagDepthCategory: Multiple depth units detected. Convert depth units to a single unit before categorizing."
+ )
}
-
+
# 3) Proceed to compute bottom depth and assign categories (NA-aware)
# use group_by to identify profile data
.data <- .data |>
@@ -265,21 +279,24 @@ TADA_FlagDepthCategory <- function(
!is.na(surfacevalue) &
!is.na(TADA.ConsolidatedDepth) &
TADA.ConsolidatedDepth <= surfacevalue ~ "Surface",
-
+
# Bottom only if bottomvalue and bottom depth are available
!is.na(bottomvalue) &
!is.na(TADA.ConsolidatedDepth.Bottom) &
!is.na(TADA.ConsolidatedDepth) &
- TADA.ConsolidatedDepth >= (TADA.ConsolidatedDepth.Bottom - bottomvalue) &
+ TADA.ConsolidatedDepth >=
+ (TADA.ConsolidatedDepth.Bottom - bottomvalue) &
TADA.ConsolidatedDepth <= TADA.ConsolidatedDepth.Bottom ~ "Bottom",
-
+
# Middle only if both surfacevalue and bottomvalue are provided (and bottom available)
- !is.na(surfacevalue) & !is.na(bottomvalue) &
+ !is.na(surfacevalue) &
+ !is.na(bottomvalue) &
!is.na(TADA.ConsolidatedDepth.Bottom) &
!is.na(TADA.ConsolidatedDepth) &
TADA.ConsolidatedDepth > surfacevalue &
- TADA.ConsolidatedDepth < (TADA.ConsolidatedDepth.Bottom - bottomvalue) ~ "Middle",
-
+ TADA.ConsolidatedDepth <
+ (TADA.ConsolidatedDepth.Bottom - bottomvalue) ~ "Middle",
+
TRUE ~ NA_character_
)
) |>
@@ -287,7 +304,9 @@ TADA_FlagDepthCategory <- function(
dplyr::left_join(ard.ref, by = "ActivityRelativeDepthName") |>
dplyr::mutate(
TADA.DepthCategory.Flag = ifelse(
- is.na(TADA.DepthCategory.Flag), ARD_Category, TADA.DepthCategory.Flag
+ is.na(TADA.DepthCategory.Flag),
+ ARD_Category,
+ TADA.DepthCategory.Flag
),
TADA.DepthCategory.Flag = ifelse(
is.na(TADA.ActivityDepthHeightMeasure.MeasureValue) &
From 9c01a2b82c012244c01313472117db6baed03d7a Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 09:04:24 -0400
Subject: [PATCH 07/23] make min and max behavior the same
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Behavior after the change
dailyagg = "min" or "max":
aggregatedonly = FALSE: All original rows are preserved for each group; the selected row is flagged as “Selected as min/max aggregate value …”, and all other rows in the same group are flagged as “Considered in minimum/maximum aggregation … but not selected.”
aggregatedonly = TRUE: Only the selected rows are returned (no new IDs, no duplicates).
dailyagg = "avg": Remains unchanged (still creates a separate aggregate row). If you want this to also avoid creating a new row, let me know and I’ll provide a parallel patch.
---
R/DepthProfile.R | 35 +++++++++++++++++++----------------
1 file changed, 19 insertions(+), 16 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 8eb01b1e9..d36aa103d 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -579,7 +579,7 @@ TADA_FlagDepthCategory <- function(
# combine original and aggregate data
comb.data <- orig.data |>
dplyr::filter(!ResultIdentifier %in% agg.list) |>
- plyr::rbind.fill(agg.data) |>
+ dplyr::bind_rows(agg.data) |>
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
@@ -592,8 +592,8 @@ TADA_FlagDepthCategory <- function(
if ((dailyagg == "max")) {
message("TADA_FlagDepthCategory: Selecting maximum aggregate value.")
-
- # add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
+
+ # Flag all rows (in groups with >1 depth) as considered/not selected by default
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) |>
@@ -606,10 +606,16 @@ TADA_FlagDepthCategory <- function(
"but not selected"
),
"No aggregation needed"
+ ),
+ # If a row is outside depth categories, mark as "No aggregation needed"
+ TADA.DepthProfileAggregation.Flag = ifelse(
+ !TADA.DepthCategory.Flag %in% depthcat.list,
+ "No aggregation needed",
+ TADA.DepthProfileAggregation.Flag
)
)
-
- # add TADA.ResultValue.Aggregation.Flag, remove necessary columns, and select maximum result value per group.
+
+ # Select the maximum result per group (only rows in depth categories)
agg.data <- orig.data |>
dplyr::filter(
DepthsByGroup > 1,
@@ -622,38 +628,35 @@ TADA_FlagDepthCategory <- function(
) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = paste0(
- "TADA_FlagDepthCategory: Selecting maximum aggregate value.",
+ "Selected as max aggregate value ",
cattype
)
) |>
- dplyr::mutate(ResultIdentifier = paste0("TADA-", ResultIdentifier)) |>
dplyr::select(-DepthsByGroup) |>
dplyr::ungroup()
-
+
if (aggregatedonly == TRUE) {
rm(orig.data)
-
return(agg.data)
}
-
+
if (aggregatedonly == FALSE) {
- # create list of result identifiers for selected aggregate data
+ # Remove the selected rows from the original so they are not duplicated,
+ # then add them back with the "selected" flag applied above
agg.list <- agg.data |>
dplyr::ungroup() |>
dplyr::select(ResultIdentifier) |>
unique() |>
dplyr::pull()
-
- # combine original and aggregate data
+
comb.data <- orig.data |>
dplyr::filter(!ResultIdentifier %in% agg.list) |>
- plyr::rbind.fill(agg.data) |>
+ dplyr::bind_rows(agg.data) |>
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
-
+
rm(agg.data, orig.data, agg.list)
-
return(comb.data)
}
}
From 6bc342c53891cb21fdc65550c8c66d27b6ae453e Mon Sep 17 00:00:00 2001
From: "pre-commit-ci[bot]"
<66853113+pre-commit-ci[bot]@users.noreply.github.com>
Date: Tue, 28 Apr 2026 13:06:51 +0000
Subject: [PATCH 08/23] [pre-commit.ci] auto fixes from pre-commit.com hooks
for more information, see https://pre-commit.ci
---
R/DepthProfile.R | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index d36aa103d..b6c301ff5 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -592,7 +592,7 @@ TADA_FlagDepthCategory <- function(
if ((dailyagg == "max")) {
message("TADA_FlagDepthCategory: Selecting maximum aggregate value.")
-
+
# Flag all rows (in groups with >1 depth) as considered/not selected by default
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -614,7 +614,7 @@ TADA_FlagDepthCategory <- function(
TADA.DepthProfileAggregation.Flag
)
)
-
+
# Select the maximum result per group (only rows in depth categories)
agg.data <- orig.data |>
dplyr::filter(
@@ -634,12 +634,12 @@ TADA_FlagDepthCategory <- function(
) |>
dplyr::select(-DepthsByGroup) |>
dplyr::ungroup()
-
+
if (aggregatedonly == TRUE) {
rm(orig.data)
return(agg.data)
}
-
+
if (aggregatedonly == FALSE) {
# Remove the selected rows from the original so they are not duplicated,
# then add them back with the "selected" flag applied above
@@ -648,14 +648,14 @@ TADA_FlagDepthCategory <- function(
dplyr::select(ResultIdentifier) |>
unique() |>
dplyr::pull()
-
+
comb.data <- orig.data |>
dplyr::filter(!ResultIdentifier %in% agg.list) |>
dplyr::bind_rows(agg.data) |>
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
-
+
rm(agg.data, orig.data, agg.list)
return(comb.data)
}
From f2bc2cff4b1d60217f7d7bbee731bac24c6fdcfd Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 09:19:27 -0400
Subject: [PATCH 09/23] unique depth count issue
Unique depth counts: fully addressed (you replaced all occurrences with dplyr::n_distinct(..., na.rm = TRUE)).
-Inf bottom guard: addressed via has_depths/case_when (once the pipe above is fixed).
Optional: You can safely remove length.units, which is unused.
---
R/DepthProfile.R | 46 ++++++++++++++++++----------------------------
1 file changed, 18 insertions(+), 28 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index d36aa103d..e75313e66 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -262,15 +262,20 @@ TADA_FlagDepthCategory <- function(
) |>
# determine the number of Depths per group
dplyr::mutate(
- DepthsPerGroup = length(unique(TADA.ConsolidatedDepth)),
+ DepthsPerGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE),
# determine bottom value using TADA.ActivityBottomDepthHeightMeasure.MeasureValue or the max depth record for profile data
- TADA.ConsolidatedDepth.Bottom = ifelse(
+ has_depths = any(!is.na(TADA.ConsolidatedDepth)),
+ TADA.ConsolidatedDepth.Bottom = dplyr::case_when(
DepthsPerGroup > 1 &
- is.na(TADA.ActivityBottomDepthHeightMeasure.MeasureValue),
- max(TADA.ConsolidatedDepth, na.rm = TRUE),
- TADA.ActivityBottomDepthHeightMeasure.MeasureValue
+ is.na(TADA.ActivityBottomDepthHeightMeasure.MeasureValue) &
+ has_depths ~ max(TADA.ConsolidatedDepth, na.rm = TRUE),
+ DepthsPerGroup > 1 &
+ is.na(TADA.ActivityBottomDepthHeightMeasure.MeasureValue) &
+ !has_depths ~ NA_real_,
+ TRUE ~ TADA.ActivityBottomDepthHeightMeasure.MeasureValue
)
) |>
+ dplyr::select(-has_depths) |>
dplyr::ungroup() |>
dplyr::mutate(
# Only assign depth categories when the needed thresholds are available
@@ -430,7 +435,7 @@ TADA_FlagDepthCategory <- function(
# add TADA.ResultValue.Aggregation.Flag, remove unecessary columns, and order columns
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
- dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) |>
+ dplyr::mutate(DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
@@ -460,7 +465,7 @@ TADA_FlagDepthCategory <- function(
# add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
- dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) |>
+ dplyr::mutate(DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
@@ -524,7 +529,7 @@ TADA_FlagDepthCategory <- function(
# add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
- dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) |>
+ dplyr::mutate(DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
@@ -596,7 +601,7 @@ TADA_FlagDepthCategory <- function(
# Flag all rows (in groups with >1 depth) as considered/not selected by default
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
- dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) |>
+ dplyr::mutate(DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
@@ -765,24 +770,9 @@ TADA_IDDepthProfiles <- function(
"THALWEG DEPTH"
)
- if (aggregates == FALSE) {
- if ("TADA.DepthProfileAggregation.Flag" %in% names(.data) == TRUE) {
- .data <- .data |>
- dplyr::filter(
- TADA.DepthProfileAggregation.Flag !=
- c(
- "Calculated mean aggregate value, with randomly selected metadata from a row in the aggregate group"
- )
- )
-
- if ("TADA.DepthProfileAggregation.Flag" %in% names(.data) == FALSE) {
- .data <- .data
- }
- }
-
- if (aggregates == TRUE) {
- .data <- .data
- }
+ # when aggregates == FALSE, robust removal of mean-aggregated rows (created by avg)
+ if (!aggregates && "ResultIdentifier" %in% names(.data)) {
+ .data <- dplyr::filter(.data, !grepl("^TADA-", ResultIdentifier))
}
if (nresults == TRUE) {
@@ -879,7 +869,7 @@ TADA_IDDepthProfiles <- function(
ActivityStartDate,
TADA.ComparableDataIdentifier
) |>
- dplyr::mutate(TADA.NResults = length(unique(TADA.ConsolidatedDepth))) |>
+ dplyr::mutate(TADA.NResults = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
dplyr::filter(
TADA.NResults >= nvalue | TADA.CharacteristicName %in% depth.params
) |>
From 0d44ab1b123f2a58234b8585ee468a7099b7e8ee Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 09:41:00 -0400
Subject: [PATCH 10/23] Address bugs and make robust
---
R/DepthProfile.R | 29 +++++++++++++++--------------
1 file changed, 15 insertions(+), 14 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index e75313e66..b78d7e3c1 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -1003,6 +1003,9 @@ TADA_DepthProfilePlot <- function(
# check .data is data.frame
TADA_CheckType(.data, "data.frame", "Input object")
+ if (is.character(surfacevalue) && tolower(surfacevalue) == "null") surfacevalue <- NA_real_
+ if (is.character(bottomvalue) && tolower(bottomvalue) == "null") bottomvalue <- NA_real_
+
# add check that depth category flag function has been run, run it if it has not
flag.func.cols <- c(
"TADA.ConsolidatedDepth",
@@ -1074,15 +1077,12 @@ TADA_DepthProfilePlot <- function(
# add convert depth unit (this still needs to be added), for now print warning and stop function if units don't match
.data <- .data |> dplyr::filter(!is.na(TADA.ConsolidatedDepth))
-
- if (.data$TADA.ConsolidatedDepth.Unit[1] == unit) {
- message(
- "TADA_DepthProfilePlot: Depth unit in data set matches depth unit specified by user for plot. No conversion necessary."
- )
+
+ units_present <- unique(stats::na.omit(.data$TADA.ConsolidatedDepth.Unit))
+ if (length(units_present) == 0 || any(units_present != unit)) {
+ stop("TADA_DepthProfilePlot: Depth units in data do not match `unit`. Convert units or adjust `unit`.")
} else {
- stop(
- "TADA_DepthProfilePlot: Depth unit in data set does not match depth unit specified by user for plot. Convert units in data or specify correct unit in TADA_DepthProfilePlot function."
- )
+ message("TADA_DepthProfilePlot: Depth unit in data matches depth unit specified by user. No conversion necessary.")
}
# create ID Depth Profiles data.frame to check against params
@@ -1262,6 +1262,7 @@ TADA_DepthProfilePlot <- function(
"TADA.ConsolidatedDepth.Unit",
"TADA.ConsolidatedDepth.Bottom",
"TADA.ActivityMediaName",
+ "ActivityMediaSubdivisionName",
"TADA.ComparableDataIdentifier"
)
@@ -1618,7 +1619,7 @@ TADA_DepthProfilePlot <- function(
# first parameter has a depth profile
if (
- length(groups) >= 1 & !param1$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 1 && nrow(param1) > 0 && !param1$TADA.CharacteristicName[1] %in% depth.params
) {
# config options https://plotly.com/r/configuration-options/
scatterplot <- scatterplot |>
@@ -1674,7 +1675,7 @@ TADA_DepthProfilePlot <- function(
# first parameter has a single value where units are depth
if (
- length(groups) >= 1 & param1$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 1 && nrow(param1) > 0 && param1$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1727,7 +1728,7 @@ TADA_DepthProfilePlot <- function(
# second parameter has a depth profile
if (
- length(groups) >= 2 & !param2$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 2 && nrow(param2) > 0 && !param2$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_trace(
@@ -1781,7 +1782,7 @@ TADA_DepthProfilePlot <- function(
# second parameter has a single value where units are depth
if (
- length(groups) >= 2 & param2$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 2 && nrow(param2) > 0 && param2$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1835,7 +1836,7 @@ TADA_DepthProfilePlot <- function(
# third parameter has a depth profile
if (
- length(groups) >= 3 & !param3$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 3 && nrow(param3) > 0 && !param3$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_trace(
@@ -1889,7 +1890,7 @@ TADA_DepthProfilePlot <- function(
# third parameter has a single value where units are depth
if (
- length(groups) >= 3 & param3$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 3 && nrow(param3) > 0 && param3$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
From 7820a17a90de948833aaa392673f0c5b997b5801 Mon Sep 17 00:00:00 2001
From: "pre-commit-ci[bot]"
<66853113+pre-commit-ci[bot]@users.noreply.github.com>
Date: Tue, 28 Apr 2026 13:41:39 +0000
Subject: [PATCH 11/23] [pre-commit.ci] auto fixes from pre-commit.com hooks
for more information, see https://pre-commit.ci
---
R/DepthProfile.R | 71 +++++++++++++++++++++++++++++++++++-------------
1 file changed, 52 insertions(+), 19 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index e2b0b4ea0..0fcd2647c 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -262,7 +262,10 @@ TADA_FlagDepthCategory <- function(
) |>
# determine the number of Depths per group
dplyr::mutate(
- DepthsPerGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE),
+ DepthsPerGroup = dplyr::n_distinct(
+ TADA.ConsolidatedDepth,
+ na.rm = TRUE
+ ),
# determine bottom value using TADA.ActivityBottomDepthHeightMeasure.MeasureValue or the max depth record for profile data
has_depths = any(!is.na(TADA.ConsolidatedDepth)),
TADA.ConsolidatedDepth.Bottom = dplyr::case_when(
@@ -435,7 +438,9 @@ TADA_FlagDepthCategory <- function(
# add TADA.ResultValue.Aggregation.Flag, remove unecessary columns, and order columns
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
- dplyr::mutate(DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
+ dplyr::mutate(
+ DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)
+ ) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
@@ -465,7 +470,9 @@ TADA_FlagDepthCategory <- function(
# add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
- dplyr::mutate(DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
+ dplyr::mutate(
+ DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)
+ ) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
@@ -529,7 +536,9 @@ TADA_FlagDepthCategory <- function(
# add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
- dplyr::mutate(DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
+ dplyr::mutate(
+ DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)
+ ) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
@@ -601,7 +610,9 @@ TADA_FlagDepthCategory <- function(
# Flag all rows (in groups with >1 depth) as considered/not selected by default
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
- dplyr::mutate(DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
+ dplyr::mutate(
+ DepthsByGroup = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)
+ ) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = ifelse(
DepthsByGroup > 1,
@@ -770,7 +781,7 @@ TADA_IDDepthProfiles <- function(
"THALWEG DEPTH"
)
- # when aggregates == FALSE, robust removal of mean-aggregated rows (created by avg)
+ # when aggregates == FALSE, robust removal of mean-aggregated rows (created by avg)
if (!aggregates && "ResultIdentifier" %in% names(.data)) {
.data <- dplyr::filter(.data, !grepl("^TADA-", ResultIdentifier))
}
@@ -869,7 +880,9 @@ TADA_IDDepthProfiles <- function(
ActivityStartDate,
TADA.ComparableDataIdentifier
) |>
- dplyr::mutate(TADA.NResults = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)) |>
+ dplyr::mutate(
+ TADA.NResults = dplyr::n_distinct(TADA.ConsolidatedDepth, na.rm = TRUE)
+ ) |>
dplyr::filter(
TADA.NResults >= nvalue | TADA.CharacteristicName %in% depth.params
) |>
@@ -1003,9 +1016,13 @@ TADA_DepthProfilePlot <- function(
# check .data is data.frame
TADA_CheckType(.data, "data.frame", "Input object")
- if (is.character(surfacevalue) && tolower(surfacevalue) == "null") surfacevalue <- NA_real_
- if (is.character(bottomvalue) && tolower(bottomvalue) == "null") bottomvalue <- NA_real_
-
+ if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
+ surfacevalue <- NA_real_
+ }
+ if (is.character(bottomvalue) && tolower(bottomvalue) == "null") {
+ bottomvalue <- NA_real_
+ }
+
# add check that depth category flag function has been run, run it if it has not
flag.func.cols <- c(
"TADA.ConsolidatedDepth",
@@ -1077,12 +1094,16 @@ TADA_DepthProfilePlot <- function(
# add convert depth unit (this still needs to be added), for now print warning and stop function if units don't match
.data <- .data |> dplyr::filter(!is.na(TADA.ConsolidatedDepth))
-
+
units_present <- unique(stats::na.omit(.data$TADA.ConsolidatedDepth.Unit))
if (length(units_present) == 0 || any(units_present != unit)) {
- stop("TADA_DepthProfilePlot: Depth units in data do not match `unit`. Convert units or adjust `unit`.")
+ stop(
+ "TADA_DepthProfilePlot: Depth units in data do not match `unit`. Convert units or adjust `unit`."
+ )
} else {
- message("TADA_DepthProfilePlot: Depth unit in data matches depth unit specified by user. No conversion necessary.")
+ message(
+ "TADA_DepthProfilePlot: Depth unit in data matches depth unit specified by user. No conversion necessary."
+ )
}
# create ID Depth Profiles data.frame to check against params
@@ -1619,7 +1640,9 @@ TADA_DepthProfilePlot <- function(
# first parameter has a depth profile
if (
- length(groups) >= 1 && nrow(param1) > 0 && !param1$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 1 &&
+ nrow(param1) > 0 &&
+ !param1$TADA.CharacteristicName[1] %in% depth.params
) {
# config options https://plotly.com/r/configuration-options/
scatterplot <- scatterplot |>
@@ -1675,7 +1698,9 @@ TADA_DepthProfilePlot <- function(
# first parameter has a single value where units are depth
if (
- length(groups) >= 1 && nrow(param1) > 0 && param1$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 1 &&
+ nrow(param1) > 0 &&
+ param1$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1728,7 +1753,9 @@ TADA_DepthProfilePlot <- function(
# second parameter has a depth profile
if (
- length(groups) >= 2 && nrow(param2) > 0 && !param2$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 2 &&
+ nrow(param2) > 0 &&
+ !param2$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_trace(
@@ -1782,7 +1809,9 @@ TADA_DepthProfilePlot <- function(
# second parameter has a single value where units are depth
if (
- length(groups) >= 2 && nrow(param2) > 0 && param2$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 2 &&
+ nrow(param2) > 0 &&
+ param2$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1836,7 +1865,9 @@ TADA_DepthProfilePlot <- function(
# third parameter has a depth profile
if (
- length(groups) >= 3 && nrow(param3) > 0 && !param3$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 3 &&
+ nrow(param3) > 0 &&
+ !param3$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_trace(
@@ -1890,7 +1921,9 @@ TADA_DepthProfilePlot <- function(
# third parameter has a single value where units are depth
if (
- length(groups) >= 3 && nrow(param3) > 0 && param3$TADA.CharacteristicName[1] %in% depth.params
+ length(groups) >= 3 &&
+ nrow(param3) > 0 &&
+ param3$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
From 36a3fb3f644ae64730ba865bf37d4dc077dacbc8 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 10:01:44 -0400
Subject: [PATCH 12/23] Update DepthProfile.R
This change ensures that if only some required columns are present, the code reliably falls into the else branch to add the missing columns by calling TADA_FlagDepthCategory.
---
R/DepthProfile.R | 37 ++++++++++++++++---------------------
1 file changed, 16 insertions(+), 21 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 0fcd2647c..291d5422f 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -337,14 +337,16 @@ TADA_FlagDepthCategory <- function(
message(
"TADA_FlagDepthCategory: No depth information was found in the dataset. The columns TADA.DepthCategory.Flag and TADA.ConsolidatedDepth are being added and populated with NA values."
)
-
+
.data <- .data |>
dplyr::mutate(
- TADA.DepthCategory.Flag = as.character(NA),
- TADA.ConsolidatedDepth = as.numeric(NA)
+ TADA.DepthCategory.Flag = NA_character_,
+ TADA.ConsolidatedDepth = as.numeric(NA),
+ TADA.ConsolidatedDepth.Unit = NA_character_,
+ TADA.ConsolidatedDepth.Bottom = as.numeric(NA)
) |>
TADA_OrderCols()
-
+
return(.data)
}
@@ -520,7 +522,7 @@ TADA_FlagDepthCategory <- function(
if (aggregatedonly == FALSE) {
# combine original and aggregate data
- comb.data <- plyr::rbind.fill(orig.data, agg.data) |>
+ comb.data <- dplyr::bind_rows(orig.data, agg.data) |>
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
@@ -694,7 +696,7 @@ TADA_FlagDepthCategory <- function(
#'
#' @param .data TADA dataframe which must include the columns ActivityStartDate,
#' TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Unit, TADA.ConsolidatedDepth.Bottom,
-#' TADA.ResultMeasureValue, TADA.ResultMeasureValue.UnitCode,
+#' TADA.ResultMeasureValue, TADA.ResultMeasure.MeasureUnitCode,
#' OrganizationIdentifier, TADA.MonitoringLocationName, TADA.MonitoringLocationIdentifier,
#' and TADA.ComparableDataIdentifier.
#'
@@ -752,20 +754,16 @@ TADA_IDDepthProfiles <- function(
"TADA.DepthCategory.Flag",
"TADA.DepthProfileAggregation.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
message(
"TADA_IDDepthProfiles: Necessary columns from TADA_FlagDepthCategory function are included in the data frame."
)
-
.data <- .data
- }
-
- if (any(flag.func.cols %in% colnames(.data)) == FALSE) {
+ } else {
message(
"TADA_IDDepthProfiles: Necessary columns are being added to the data frame using TADA_DepthCatgegory.Flag function."
)
-
.data <- TADA_FlagDepthCategory(.data)
}
@@ -1030,20 +1028,17 @@ TADA_DepthProfilePlot <- function(
"TADA.ConsolidatedDepth.Bottom",
"TADA.DepthCategory.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
message(
"TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame"
)
-
.data <- .data
- }
-
- if (any(flag.func.cols %in% colnames(.data)) == FALSE) {
+ } else {
message(
"TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame"
)
-
+
if (bottomvalue == "null" & surfacevalue == "null") {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1052,7 +1047,7 @@ TADA_DepthProfilePlot <- function(
) |>
dplyr::mutate(TADA.DepthCategory.Flag = NA)
}
-
+
if (surfacevalue == "null" & is.numeric(bottomvalue)) {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1067,7 +1062,7 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
if (bottomvalue == "null" & is.numeric(surfacevalue)) {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1082,7 +1077,7 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
if (is.numeric(bottomvalue) & is.numeric(surfacevalue)) {
.data <- TADA_FlagDepthCategory(
.data,
From cf517094465a13d9b55c535a40a2cdfb8c5512b8 Mon Sep 17 00:00:00 2001
From: "pre-commit-ci[bot]"
<66853113+pre-commit-ci[bot]@users.noreply.github.com>
Date: Tue, 28 Apr 2026 14:35:14 +0000
Subject: [PATCH 13/23] [pre-commit.ci] auto fixes from pre-commit.com hooks
for more information, see https://pre-commit.ci
---
R/DepthProfile.R | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 291d5422f..7c064d273 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -337,7 +337,7 @@ TADA_FlagDepthCategory <- function(
message(
"TADA_FlagDepthCategory: No depth information was found in the dataset. The columns TADA.DepthCategory.Flag and TADA.ConsolidatedDepth are being added and populated with NA values."
)
-
+
.data <- .data |>
dplyr::mutate(
TADA.DepthCategory.Flag = NA_character_,
@@ -346,7 +346,7 @@ TADA_FlagDepthCategory <- function(
TADA.ConsolidatedDepth.Bottom = as.numeric(NA)
) |>
TADA_OrderCols()
-
+
return(.data)
}
@@ -754,7 +754,7 @@ TADA_IDDepthProfiles <- function(
"TADA.DepthCategory.Flag",
"TADA.DepthProfileAggregation.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
message(
"TADA_IDDepthProfiles: Necessary columns from TADA_FlagDepthCategory function are included in the data frame."
@@ -1028,7 +1028,7 @@ TADA_DepthProfilePlot <- function(
"TADA.ConsolidatedDepth.Bottom",
"TADA.DepthCategory.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
message(
"TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame"
@@ -1038,7 +1038,7 @@ TADA_DepthProfilePlot <- function(
message(
"TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame"
)
-
+
if (bottomvalue == "null" & surfacevalue == "null") {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1047,7 +1047,7 @@ TADA_DepthProfilePlot <- function(
) |>
dplyr::mutate(TADA.DepthCategory.Flag = NA)
}
-
+
if (surfacevalue == "null" & is.numeric(bottomvalue)) {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1062,7 +1062,7 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
if (bottomvalue == "null" & is.numeric(surfacevalue)) {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1077,7 +1077,7 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
if (is.numeric(bottomvalue) & is.numeric(surfacevalue)) {
.data <- TADA_FlagDepthCategory(
.data,
From 1d00565079d9c71f81cfc4e8d1357c401ab10b25 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 10:37:34 -0400
Subject: [PATCH 14/23] TADA_IDDepthProfiles bug
This change prevents if(NA) errors by removing all string comparisons to "null" and using is.na(...) to branch on missing thresholds.
---
R/DepthProfile.R | 40 ++++++++++++-------------------------
man/TADA_IDDepthProfiles.Rd | 2 +-
2 files changed, 14 insertions(+), 28 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 291d5422f..301fc7159 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -1014,14 +1014,11 @@ TADA_DepthProfilePlot <- function(
# check .data is data.frame
TADA_CheckType(.data, "data.frame", "Input object")
- if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
- surfacevalue <- NA_real_
- }
- if (is.character(bottomvalue) && tolower(bottomvalue) == "null") {
- bottomvalue <- NA_real_
- }
-
- # add check that depth category flag function has been run, run it if it has not
+ # Normalize "null" to NA
+ if (is.character(surfacevalue) && tolower(surfacevalue) == "null") surfacevalue <- NA_real_
+ if (is.character(bottomvalue) && tolower(bottomvalue) == "null") bottomvalue <- NA_real_
+
+ # Add check that depth category flag function has been run, run it if it has not
flag.func.cols <- c(
"TADA.ConsolidatedDepth",
"TADA.ConsolidatedDepth.Unit",
@@ -1029,26 +1026,19 @@ TADA_DepthProfilePlot <- function(
"TADA.DepthCategory.Flag"
)
- if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
- message(
- "TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame"
- )
- .data <- .data
- } else {
+ if (any(flag.func.cols %in% colnames(.data)) == FALSE) {
message(
"TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame"
)
- if (bottomvalue == "null" & surfacevalue == "null") {
+ if (is.na(surfacevalue) && is.na(bottomvalue)) {
.data <- TADA_FlagDepthCategory(
.data,
surfacevalue = 2,
bottomvalue = 2
) |>
- dplyr::mutate(TADA.DepthCategory.Flag = NA)
- }
-
- if (surfacevalue == "null" & is.numeric(bottomvalue)) {
+ dplyr::mutate(TADA.DepthCategory.Flag = NA_character_)
+ } else if (is.na(surfacevalue) && is.numeric(bottomvalue)) {
.data <- TADA_FlagDepthCategory(
.data,
surfacevalue = 2,
@@ -1057,13 +1047,11 @@ TADA_DepthProfilePlot <- function(
dplyr::mutate(
TADA.DepthCategory.Flag = ifelse(
TADA.DepthCategory.Flag %in% c("Surface", "Middle"),
- NA,
+ NA_character_,
TADA.DepthCategory.Flag
)
)
- }
-
- if (bottomvalue == "null" & is.numeric(surfacevalue)) {
+ } else if (is.na(bottomvalue) && is.numeric(surfacevalue)) {
.data <- TADA_FlagDepthCategory(
.data,
surfacevalue = surfacevalue,
@@ -1072,13 +1060,11 @@ TADA_DepthProfilePlot <- function(
dplyr::mutate(
TADA.DepthCategory.Flag = ifelse(
TADA.DepthCategory.Flag %in% c("Bottom", "Middle"),
- NA,
+ NA_character_,
TADA.DepthCategory.Flag
)
)
- }
-
- if (is.numeric(bottomvalue) & is.numeric(surfacevalue)) {
+ } else {
.data <- TADA_FlagDepthCategory(
.data,
surfacevalue = surfacevalue,
diff --git a/man/TADA_IDDepthProfiles.Rd b/man/TADA_IDDepthProfiles.Rd
index 6e0d93e54..695628cae 100644
--- a/man/TADA_IDDepthProfiles.Rd
+++ b/man/TADA_IDDepthProfiles.Rd
@@ -9,7 +9,7 @@ TADA_IDDepthProfiles(.data, nresults = TRUE, nvalue = 2, aggregates = FALSE)
\arguments{
\item{.data}{TADA dataframe which must include the columns ActivityStartDate,
TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Unit, TADA.ConsolidatedDepth.Bottom,
-TADA.ResultMeasureValue, TADA.ResultMeasureValue.UnitCode,
+TADA.ResultMeasureValue, TADA.ResultMeasure.MeasureUnitCode,
OrganizationIdentifier, TADA.MonitoringLocationName, TADA.MonitoringLocationIdentifier,
and TADA.ComparableDataIdentifier.}
From 6e666ae97b11edcccb6d5142768eafe0a05211e7 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 10:39:46 -0400
Subject: [PATCH 15/23] TADA_DepthProfilePlot unit conversion bug
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Only the unit-conversion branching is changed from a nested if (which can never execute) to an if/else so the conversion actually runs when units don’t match. Everything else remains the same.
---
R/DepthProfile.R | 128 +++++++++++++++++------------------------------
1 file changed, 45 insertions(+), 83 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 301fc7159..5204451e9 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -1378,92 +1378,54 @@ TADA_DepthProfilePlot <- function(
depth.params.string,
"match the depth unit selected for the figure."
))
-
depth.params.avail <- depth.params.avail
-
- if (
- unique(depth.params.avail$TADA.ConsolidatedDepth.Unit) != fig.depth.unit
- ) {
- message(paste(
- "TADA_DepthProfilePlot: Converting depth units for any results for",
- depth.params.string,
- "results to match depth units selected for the figure."
- ))
-
- depth.units <- c(
- "m",
- "ft",
- "in",
- "m",
- "m",
- "ft",
- "ft",
- "in",
- "in",
- "m",
- "ft",
- "in"
- )
-
- result.units <- c(
- "m",
- "ft",
- "in",
- "ft",
- "in",
- "m",
- "in",
- "m",
- "ft",
- "cm",
- "cm",
- "cm"
- )
-
- convert.factor <- c(
- "1",
- "1",
- "1",
- "0.3048",
- "0.0254",
- "3.281",
- "0.083",
- "39.3701",
- "12",
- "0.01",
- "0.032808",
- "0.39"
+ } else {
+ message(paste(
+ "TADA_DepthProfilePlot: Converting depth units for any results for",
+ depth.params.string,
+ "results to match depth units selected for the figure."
+ ))
+
+ depth.units <- c(
+ "m", "ft", "in", "m", "m", "ft", "ft", "in", "in", "m", "ft", "in"
+ )
+
+ result.units <- c(
+ "m", "ft", "in", "ft", "in", "m", "in", "m", "ft", "cm", "cm", "cm"
+ )
+
+ convert.factor <- c(
+ "1", "1", "1", "0.3048", "0.0254", "3.281", "0.083", "39.3701",
+ "12", "0.01", "0.032808", "0.39"
+ )
+
+ secchi.conversion <- data.frame(
+ result.units, depth.units, convert.factor
+ ) |>
+ dplyr::rename(
+ TADA.ConsolidatedDepth.Unit = result.units,
+ YAxis.DepthUnit = depth.units,
+ SecchiConversion = convert.factor
)
-
- secchi.conversion <- data.frame(
- result.units,
- depth.units,
- convert.factor
+
+ depth.params.avail <- depth.params.avail |>
+ dplyr::mutate(YAxis.DepthUnit = fig.depth.unit) |>
+ dplyr::left_join(secchi.conversion) |>
+ dplyr::mutate(
+ TADA.ConsolidatedDepth.Unit = fig.depth.unit,
+ TADA.ConsolidatedDepth = TADA.ResultMeasureValue *
+ as.numeric(SecchiConversion)
) |>
- dplyr::rename(
- TADA.ConsolidatedDepth.Unit = result.units,
- YAxis.DepthUnit = depth.units,
- SecchiConversion = convert.factor
- )
-
- depth.params.avail <- depth.params.avail |>
- dplyr::mutate(YAxis.DepthUnit = fig.depth.unit) |>
- dplyr::left_join(secchi.conversion) |>
- dplyr::mutate(
- TADA.ConsolidatedDepth.Unit = fig.depth.unit,
- TADA.ConsolidatedDepth = TADA.ResultMeasureValue *
- as.numeric(SecchiConversion)
- ) |>
- dplyr::select(-YAxis.DepthUnit, -SecchiConversion)
-
- rm(
- secchi.conversion,
- depth.params.string,
- depth.units,
- result.units,
- convert.factor
- )
- }
+ dplyr::select(-YAxis.DepthUnit, -SecchiConversion)
+
+ rm(
+ secchi.conversion,
+ depth.params.string,
+ depth.units,
+ result.units,
+ convert.factor
+ )
+ }
}
profile.data <- dplyr::bind_rows(depthprofile.avail, depth.params.avail)
From 188391ae9473dcffeb23946b27ac067117c11d3d Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 10:49:52 -0400
Subject: [PATCH 16/23] TADA_DepthProfilePlot column check
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Column‑presence check should use all(...) with an else branch
---
R/DepthProfile.R | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 5204451e9..04a9d0487 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -1026,10 +1026,11 @@ TADA_DepthProfilePlot <- function(
"TADA.DepthCategory.Flag"
)
- if (any(flag.func.cols %in% colnames(.data)) == FALSE) {
- message(
- "TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame"
- )
+ if (all(flag.func.cols %in% colnames(.data))) {
+ message("TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame")
+ .data <- .data
+ } else {
+ message("TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame")
if (is.na(surfacevalue) && is.na(bottomvalue)) {
.data <- TADA_FlagDepthCategory(
From 0d5b14bf23a4c83a8b6d056f60451a8dedb56c10 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 10:56:35 -0400
Subject: [PATCH 17/23] TADA_DepthProfilePlot fix
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Keep bind_rows and rm inside the “depth params present” block (brace fix)
---
R/DepthProfile.R | 75 +++++++++---------------------------------------
1 file changed, 13 insertions(+), 62 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 04a9d0487..afaa132a7 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -1328,34 +1328,12 @@ TADA_DepthProfilePlot <- function(
dplyr::pull()
# if any depth parameter (ex: secchi) data
-
- if (length(intersect(groups, depth.params.groups)) == 0) {
- depth.params.string <- paste(depth.params, collapse = "; ")
-
- profile.data <- depthprofile.avail
-
- rm(depth.params.string, depthprofile.avail)
- }
-
if (length(intersect(groups, depth.params.groups)) > 0) {
# add depth param (ex: secchi) results
depth.params.string <- paste(depth.params, collapse = "; ")
-
- depth.units <- c(
- "m",
- "ft",
- "in",
- "m",
- "m",
- "ft",
- "ft",
- "in",
- "in",
- "m",
- "ft",
- "in"
- )
-
+
+ depth.units <- c("m","ft","in","m","m","ft","ft","in","in","m","ft","in")
+
depth.params.avail <- .data |>
dplyr::filter(
TADA.MonitoringLocationIdentifier %in% location,
@@ -1370,39 +1348,23 @@ TADA_DepthProfilePlot <- function(
) |>
dplyr::slice_sample(n = 1) |>
dplyr::ungroup()
-
- if (
- unique(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit
- ) {
+
+ if (unique(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit) {
message(paste(
- "TADA_DepthProfilePlot: Any results for",
- depth.params.string,
+ "TADA_DepthProfilePlot: Any results for", depth.params.string,
"match the depth unit selected for the figure."
))
- depth.params.avail <- depth.params.avail
} else {
message(paste(
"TADA_DepthProfilePlot: Converting depth units for any results for",
- depth.params.string,
- "results to match depth units selected for the figure."
+ depth.params.string, "results to match depth units selected for the figure."
))
- depth.units <- c(
- "m", "ft", "in", "m", "m", "ft", "ft", "in", "in", "m", "ft", "in"
- )
-
- result.units <- c(
- "m", "ft", "in", "ft", "in", "m", "in", "m", "ft", "cm", "cm", "cm"
- )
+ depth.units <- c("m","ft","in","m","m","ft","ft","in","in","m","ft","in")
+ result.units <- c("m","ft","in","ft","in","m","in","m","ft","cm","cm","cm")
+ convert.factor<- c("1","1","1","0.3048","0.0254","3.281","0.083","39.3701","12","0.01","0.032808","0.39")
- convert.factor <- c(
- "1", "1", "1", "0.3048", "0.0254", "3.281", "0.083", "39.3701",
- "12", "0.01", "0.032808", "0.39"
- )
-
- secchi.conversion <- data.frame(
- result.units, depth.units, convert.factor
- ) |>
+ secchi.conversion <- data.frame(result.units, depth.units, convert.factor) |>
dplyr::rename(
TADA.ConsolidatedDepth.Unit = result.units,
YAxis.DepthUnit = depth.units,
@@ -1414,23 +1376,12 @@ TADA_DepthProfilePlot <- function(
dplyr::left_join(secchi.conversion) |>
dplyr::mutate(
TADA.ConsolidatedDepth.Unit = fig.depth.unit,
- TADA.ConsolidatedDepth = TADA.ResultMeasureValue *
- as.numeric(SecchiConversion)
+ TADA.ConsolidatedDepth = TADA.ResultMeasureValue * as.numeric(SecchiConversion)
) |>
dplyr::select(-YAxis.DepthUnit, -SecchiConversion)
-
- rm(
- secchi.conversion,
- depth.params.string,
- depth.units,
- result.units,
- convert.factor
- )
- }
}
-
+
profile.data <- dplyr::bind_rows(depthprofile.avail, depth.params.avail)
-
rm(depth.params.avail, depthprofile.avail)
}
From f0673ba3eb6a96ffef58b2db568ce79c2853266d Mon Sep 17 00:00:00 2001
From: "pre-commit-ci[bot]"
<66853113+pre-commit-ci[bot]@users.noreply.github.com>
Date: Tue, 28 Apr 2026 14:59:16 +0000
Subject: [PATCH 18/23] [pre-commit.ci] auto fixes from pre-commit.com hooks
for more information, see https://pre-commit.ci
---
R/DepthProfile.R | 121 +++++++++++++++++++++++++++++++++++++----------
1 file changed, 95 insertions(+), 26 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index afaa132a7..40fb41cc1 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -337,7 +337,7 @@ TADA_FlagDepthCategory <- function(
message(
"TADA_FlagDepthCategory: No depth information was found in the dataset. The columns TADA.DepthCategory.Flag and TADA.ConsolidatedDepth are being added and populated with NA values."
)
-
+
.data <- .data |>
dplyr::mutate(
TADA.DepthCategory.Flag = NA_character_,
@@ -346,7 +346,7 @@ TADA_FlagDepthCategory <- function(
TADA.ConsolidatedDepth.Bottom = as.numeric(NA)
) |>
TADA_OrderCols()
-
+
return(.data)
}
@@ -754,7 +754,7 @@ TADA_IDDepthProfiles <- function(
"TADA.DepthCategory.Flag",
"TADA.DepthProfileAggregation.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
message(
"TADA_IDDepthProfiles: Necessary columns from TADA_FlagDepthCategory function are included in the data frame."
@@ -1015,9 +1015,13 @@ TADA_DepthProfilePlot <- function(
TADA_CheckType(.data, "data.frame", "Input object")
# Normalize "null" to NA
- if (is.character(surfacevalue) && tolower(surfacevalue) == "null") surfacevalue <- NA_real_
- if (is.character(bottomvalue) && tolower(bottomvalue) == "null") bottomvalue <- NA_real_
-
+ if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
+ surfacevalue <- NA_real_
+ }
+ if (is.character(bottomvalue) && tolower(bottomvalue) == "null") {
+ bottomvalue <- NA_real_
+ }
+
# Add check that depth category flag function has been run, run it if it has not
flag.func.cols <- c(
"TADA.ConsolidatedDepth",
@@ -1025,13 +1029,17 @@ TADA_DepthProfilePlot <- function(
"TADA.ConsolidatedDepth.Bottom",
"TADA.DepthCategory.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data))) {
- message("TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame")
+ message(
+ "TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame"
+ )
.data <- .data
} else {
- message("TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame")
-
+ message(
+ "TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame"
+ )
+
if (is.na(surfacevalue) && is.na(bottomvalue)) {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1331,9 +1339,22 @@ TADA_DepthProfilePlot <- function(
if (length(intersect(groups, depth.params.groups)) > 0) {
# add depth param (ex: secchi) results
depth.params.string <- paste(depth.params, collapse = "; ")
-
- depth.units <- c("m","ft","in","m","m","ft","ft","in","in","m","ft","in")
-
+
+ depth.units <- c(
+ "m",
+ "ft",
+ "in",
+ "m",
+ "m",
+ "ft",
+ "ft",
+ "in",
+ "in",
+ "m",
+ "ft",
+ "in"
+ )
+
depth.params.avail <- .data |>
dplyr::filter(
TADA.MonitoringLocationIdentifier %in% location,
@@ -1348,39 +1369,87 @@ TADA_DepthProfilePlot <- function(
) |>
dplyr::slice_sample(n = 1) |>
dplyr::ungroup()
-
- if (unique(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit) {
+
+ if (
+ unique(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit
+ ) {
message(paste(
- "TADA_DepthProfilePlot: Any results for", depth.params.string,
+ "TADA_DepthProfilePlot: Any results for",
+ depth.params.string,
"match the depth unit selected for the figure."
))
} else {
message(paste(
"TADA_DepthProfilePlot: Converting depth units for any results for",
- depth.params.string, "results to match depth units selected for the figure."
+ depth.params.string,
+ "results to match depth units selected for the figure."
))
-
- depth.units <- c("m","ft","in","m","m","ft","ft","in","in","m","ft","in")
- result.units <- c("m","ft","in","ft","in","m","in","m","ft","cm","cm","cm")
- convert.factor<- c("1","1","1","0.3048","0.0254","3.281","0.083","39.3701","12","0.01","0.032808","0.39")
-
- secchi.conversion <- data.frame(result.units, depth.units, convert.factor) |>
+
+ depth.units <- c(
+ "m",
+ "ft",
+ "in",
+ "m",
+ "m",
+ "ft",
+ "ft",
+ "in",
+ "in",
+ "m",
+ "ft",
+ "in"
+ )
+ result.units <- c(
+ "m",
+ "ft",
+ "in",
+ "ft",
+ "in",
+ "m",
+ "in",
+ "m",
+ "ft",
+ "cm",
+ "cm",
+ "cm"
+ )
+ convert.factor <- c(
+ "1",
+ "1",
+ "1",
+ "0.3048",
+ "0.0254",
+ "3.281",
+ "0.083",
+ "39.3701",
+ "12",
+ "0.01",
+ "0.032808",
+ "0.39"
+ )
+
+ secchi.conversion <- data.frame(
+ result.units,
+ depth.units,
+ convert.factor
+ ) |>
dplyr::rename(
TADA.ConsolidatedDepth.Unit = result.units,
YAxis.DepthUnit = depth.units,
SecchiConversion = convert.factor
)
-
+
depth.params.avail <- depth.params.avail |>
dplyr::mutate(YAxis.DepthUnit = fig.depth.unit) |>
dplyr::left_join(secchi.conversion) |>
dplyr::mutate(
TADA.ConsolidatedDepth.Unit = fig.depth.unit,
- TADA.ConsolidatedDepth = TADA.ResultMeasureValue * as.numeric(SecchiConversion)
+ TADA.ConsolidatedDepth = TADA.ResultMeasureValue *
+ as.numeric(SecchiConversion)
) |>
dplyr::select(-YAxis.DepthUnit, -SecchiConversion)
}
-
+
profile.data <- dplyr::bind_rows(depthprofile.avail, depth.params.avail)
rm(depth.params.avail, depthprofile.avail)
}
From 9c5843237a0aa3d5633409c4d7effc88e02f4086 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 13:16:10 -0400
Subject: [PATCH 19/23] Update TADA_DepthProfilePlot
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
TADA_DepthProfilePlot: fix critical runtime bugs and unreachable logic
Add fail-fast argument validation for location, activity_date, and groups; remove unreachable code and verify values exist in the input data.
Treat ActivityStartDateTime as optional: auto-create the column if missing and expand required columns to include fields used in hover text.
Restrict depth-unit consistency check to non–depth-parameter rows, allowing later conversion of depth-parameter (e.g., Secchi) rows; stop if non-depth units don’t match the requested unit.
Ensure profile.data is always defined by using depthprofile.avail when no requested groups are depth-parameter characteristics.
Use is.na instead of is.null for surfacevalue and bottomvalue in depth category annotation logic to correctly handle “null” inputs normalized to NA.
---
R/DepthProfile.R | 367 ++++++++++++++++-------------------------------
1 file changed, 123 insertions(+), 244 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 40fb41cc1..765f76733 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -1082,181 +1082,67 @@ TADA_DepthProfilePlot <- function(
}
}
- # add convert depth unit (this still needs to be added), for now print warning and stop function if units don't match
+ # Define depth-parameter characteristics (needed before unit checks)
+ depth.params <- c(
+ "DEPTH, SECCHI DISK DEPTH",
+ "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
+ "DEPTH, SECCHI DISK DEPTH REAPPEARS",
+ "DEPTH, DATA-LOGGER (NON-PORTED)",
+ "DEPTH, DATA-LOGGER (PORTED)",
+ "TRANSPARENCY, SECCHI TUBE WITH DISK",
+ "RBP STREAM DEPTH - RIFFLE",
+ "RBP STREAM DEPTH - RUN",
+ "THALWEG DEPTH"
+ )
+
+ # Enforce unit consistency only across non-depth-parameter rows; depth-parameter rows will be converted later
.data <- .data |> dplyr::filter(!is.na(TADA.ConsolidatedDepth))
-
- units_present <- unique(stats::na.omit(.data$TADA.ConsolidatedDepth.Unit))
- if (length(units_present) == 0 || any(units_present != unit)) {
- stop(
- "TADA_DepthProfilePlot: Depth units in data do not match `unit`. Convert units or adjust `unit`."
- )
+
+ non_depth_rows <- .data |> dplyr::filter(!TADA.CharacteristicName %in% depth.params)
+ if (nrow(non_depth_rows) > 0) {
+ units_present <- unique(stats::na.omit(non_depth_rows$TADA.ConsolidatedDepth.Unit))
+ if (length(units_present) > 1 || units_present != unit) {
+ stop("TADA_DepthProfilePlot: Convert non-depth-parameter depth units to match `unit` before plotting.")
+ } else {
+ message("TADA_DepthProfilePlot: Depth unit for non-depth-parameter rows matches `unit`.")
+ }
} else {
- message(
- "TADA_DepthProfilePlot: Depth unit in data matches depth unit specified by user. No conversion necessary."
- )
+ message("TADA_DepthProfilePlot: Only depth-parameter rows detected; unit check skipped (conversion will be applied as needed).")
}
# create ID Depth Profiles data.frame to check against params
param.check <- TADA_IDDepthProfiles(.data)
- if (is.null(location)) {
- message(
- "TADA_DepthProfilePlot: No TADA.MonitoringLocationIdentifier selected, a depth profile cannot be generated."
- )
-
- stop()
-
- if (!location %in% param.check$TADA.MonitoringLocationIdentifier) {
- message(
- "TADA_DepthProfilePlot: TADA.MonitoringLocationIdentifier selected is not in data set."
- )
-
- stop()
- }
-
- if (location %in% param.check$TADA.MonitoringLocationIdentifier) {
- message(
- "TADA_DepthProfilePlot: TADA.MonitoringLocationIdentifier selected."
- )
- }
+ # Early required-argument checks
+ if (is.null(location) || is.null(activity_date) || is.null(groups)) {
+ stop("TADA_DepthProfilePlot: Please supply 'location', 'activity_date', and 'groups'.")
}
-
- if (is.null(activity_date)) {
- message(
- "TADA_DepthProfilePlot: No ActivityStartDate selected, a depth profile cannot be generated."
- )
-
- stop()
-
- if (!activity_date %in% param.check$ActivityStartDate) {
- message(
- "TADA_DepthProfilePlot: ActivityStartDate selected is not in data set."
- )
- }
-
- stop()
-
- if (activity_date %in% param.check$ActivityStartDate) {
- message("TADA_DepthProfilePlot: ActivityStartDate selected.")
- }
+
+ # Validate they exist in the data
+ if (!location %in% .data$TADA.MonitoringLocationIdentifier) {
+ stop("TADA_DepthProfilePlot: `location` is not present in the data.")
}
-
- if (is.null(groups)) {
- message(
- "TADA_DepthProfilePlot: No groups selected, a depth profile cannot be generated."
- )
-
- stop()
-
- if (!is.null(groups)) {
- groups.length <- length(groups)
-
- if (groups.length > 0) {
- if (
- stringr::str_detect(
- param.check$TADA.CharacteristicsForDepthProfile,
- groups[1]
- ) ==
- FALSE
- ) {
- message(
- "TADA_DepthProfilePlot: First of groups for depth profile plot does not exist in data set."
- )
- }
-
- stop()
-
- if (
- stringr::str_detect(
- param.check$TADA.CharacteristicsForDepthProfile,
- groups[1]
- ) ==
- TRUE
- ) {
- message(
- "TADA:DepthProfilePlot: First of groups for depth profile exists in data set."
- )
- }
- }
-
- if (groups.length > 1) {
- if (
- stringr::str_detect(
- param.check$TADA.CharacteristicsForDepthProfile,
- groups[2]
- ) ==
- FALSE
- ) {
- message(
- "TADA_DepthProfilePlot: Second of groups for depth profile plot does not exist in data set."
- )
- }
-
- stop()
-
- if (
- stringr::str_detect(
- param.check$TADA.CharacteristicsForDepthProfile,
- groups[2]
- ) ==
- TRUE
- ) {
- message(
- "TADA:DepthProfilePlot: Second of groups for depth profile exists in data set."
- )
- }
- }
-
- if (groups.length > 2) {
- if (
- stringr::str_detect(
- param.check$TADA.CharacteristicsForDepthProfile,
- groups[3]
- ) ==
- FALSE
- ) {
- message(
- "TADA_DepthProfilePlot: Third of groups for depth profile plot does not exist in data set."
- )
- }
-
- stop()
-
- if (
- stringr::str_detect(
- param.check$TADA.CharacteristicsForDepthProfile,
- groups[3]
- ) ==
- TRUE
- ) {
- message(
- "TADA:DepthProfilePlot: Third of groups for depth profile exists in data set."
- )
- }
- }
- }
-
- if (!activity_date %in% param.check$ActivityStartDate) {
- message(
- "TADA_DepthProfilePlot: ActivityStartDate selected is not in data set."
- )
- }
-
- stop()
-
- if (activity_date %in% param.check$ActivityStartDate) {
- message("TADA_DepthProfilePlot: ActivityStartDate selected.")
- }
-
- param.check <- param.check |>
- dplyr::filter(ActivityStartDate == activity_date)
+ if (!activity_date %in% .data$ActivityStartDate) {
+ stop("TADA_DepthProfilePlot: `activity_date` is not present in the data.")
+ }
+ missing_groups <- setdiff(groups, unique(.data$TADA.ComparableDataIdentifier))
+ if (length(missing_groups) > 0) {
+ stop(paste0(
+ "TADA_DepthProfilePlot: The following `groups` are not present in the data: ",
+ paste(missing_groups, collapse = ", ")
+ ))
}
# remove param.check
rm(param.check)
- # list required columns
+ # Ensure optional datetime column exists for hover text
+ if (!"ActivityStartDateTime" %in% names(.data)) {
+ .data$ActivityStartDateTime <- NA_character_
+ }
+
+ # list required columns (include fields used in hover/name text)
required_cols <- c(
"TADA.ResultDepthHeightMeasure.MeasureValue",
"TADA.ResultDepthHeightMeasure.MeasureUnitCode",
@@ -1274,7 +1160,11 @@ TADA_DepthProfilePlot <- function(
"TADA.ConsolidatedDepth.Bottom",
"TADA.ActivityMediaName",
"ActivityMediaSubdivisionName",
- "TADA.ComparableDataIdentifier"
+ "TADA.ComparableDataIdentifier",
+ "TADA.CharacteristicName",
+ "ActivityRelativeDepthName",
+ "TADA.MethodSpeciationName",
+ "TADA.ResultSampleFractionText"
)
# check .data has required columns
@@ -1282,19 +1172,6 @@ TADA_DepthProfilePlot <- function(
message("TADA_DepthProfilePlot: Identifying available depth profile data.")
- # identify depth profile data
- depth.params <- c(
- "DEPTH, SECCHI DISK DEPTH",
- "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
- "DEPTH, SECCHI DISK DEPTH REAPPEARS",
- "DEPTH, DATA-LOGGER (NON-PORTED)",
- "DEPTH, DATA-LOGGER (PORTED)",
- "TRANSPARENCY, SECCHI TUBE WITH DISK",
- "RBP STREAM DEPTH - RIFFLE",
- "RBP STREAM DEPTH - RUN",
- "THALWEG DEPTH"
- )
-
depthprofile.avail <- .data |>
dplyr::filter(
!is.na(TADA.ConsolidatedDepth),
@@ -1328,12 +1205,8 @@ TADA_DepthProfilePlot <- function(
unique() |>
dplyr::pull()
- # identify depth unit being used in graph
- fig.depth.unit <- depthprofile.avail |>
- dplyr::select(TADA.ConsolidatedDepth.Unit) |>
- dplyr::filter(!is.na(TADA.ConsolidatedDepth.Unit)) |>
- unique() |>
- dplyr::pull()
+ # Use user-specified depth unit for the figure
+ fig.depth.unit <- unit
# if any depth parameter (ex: secchi) data
if (length(intersect(groups, depth.params.groups)) > 0) {
@@ -1370,9 +1243,8 @@ TADA_DepthProfilePlot <- function(
dplyr::slice_sample(n = 1) |>
dplyr::ungroup()
- if (
- unique(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit
- ) {
+ units_match <- all(stats::na.omit(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit)
+ if (units_match) {
message(paste(
"TADA_DepthProfilePlot: Any results for",
depth.params.string,
@@ -1452,22 +1324,17 @@ TADA_DepthProfilePlot <- function(
profile.data <- dplyr::bind_rows(depthprofile.avail, depth.params.avail)
rm(depth.params.avail, depthprofile.avail)
+ } else {
+ # no depth-parameter groups requested; use the main profile data only
+ profile.data <- depthprofile.avail
}
-
+
# this subset must include all fields included in plot hover below
plot.data <- profile.data |>
dplyr::filter(TADA.ComparableDataIdentifier %in% groups) |>
dplyr::select(
dplyr::all_of(required_cols),
- "TADA.ComparableDataIdentifier",
- "ActivityStartDateTime",
- "TADA.MonitoringLocationName",
- "TADA.ActivityMediaName",
- "ActivityMediaSubdivisionName",
- "ActivityRelativeDepthName",
- "TADA.CharacteristicName",
- "TADA.MethodSpeciationName",
- "TADA.ResultSampleFractionText"
+ "TADA.ComparableDataIdentifier"
) |>
dplyr::mutate(
TADA.ResultMeasure.MeasureUnitCode = ifelse(
@@ -1476,6 +1343,11 @@ TADA_DepthProfilePlot <- function(
TADA.ResultMeasure.MeasureUnitCode
)
)
+
+ # Ensure there is data to plot for the selected location/date/groups
+ if (nrow(plot.data) == 0) {
+ stop("TADA_DepthProfilePlot: No data found for the selected location, activity_date, and groups.")
+ }
rm(profile.data)
@@ -1486,6 +1358,18 @@ TADA_DepthProfilePlot <- function(
dplyr::filter(TADA.ComparableDataIdentifier %in% groups[2])
param3 <- plot.data |>
dplyr::filter(TADA.ComparableDataIdentifier %in% groups[3])
+
+ # Ensure each requested group has data for this location/date
+ present_groups <- plot.data |>
+ dplyr::count(TADA.ComparableDataIdentifier) |>
+ dplyr::pull(TADA.ComparableDataIdentifier)
+ missing_in_subset <- setdiff(groups, present_groups)
+ if (length(missing_in_subset) > 0) {
+ stop(paste0(
+ "TADA_DepthProfilePlot: The following `groups` have no data for the selected location and activity_date: ",
+ paste(missing_in_subset, collapse = ", ")
+ ))
+ }
# create title for figure, conditional on number of groups/characteristics selected
@@ -1663,12 +1547,12 @@ TADA_DepthProfilePlot <- function(
# first parameter has a single value where units are depth
if (
length(groups) >= 1 &&
- nrow(param1) > 0 &&
- param1$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param1) > 0 &&
+ param1$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
- y = param1$TADA.ResultMeasureValue[1],
+ y = param1$TADA.ConsolidatedDepth[1],
x = xrange,
name = TADA_CharStringRemoveNANone(paste0(
param1$TADA.ResultSampleFractionText[1],
@@ -1774,12 +1658,12 @@ TADA_DepthProfilePlot <- function(
# second parameter has a single value where units are depth
if (
length(groups) >= 2 &&
- nrow(param2) > 0 &&
- param2$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param2) > 0 &&
+ param2$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
- y = param2$TADA.ResultMeasureValue[1],
+ y = param2$TADA.ConsolidatedDepth[1],
x = xrange,
name = TADA_CharStringRemoveNANone(paste0(
param2$TADA.ResultSampleFractionText[1],
@@ -1886,12 +1770,12 @@ TADA_DepthProfilePlot <- function(
# third parameter has a single value where units are depth
if (
length(groups) >= 3 &&
- nrow(param3) > 0 &&
- param3$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param3) > 0 &&
+ param3$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
- y = param3$TADA.ResultMeasureValue[1],
+ y = param3$TADA.ConsolidatedDepth[1],
x = xrange,
name = TADA_CharStringRemoveNANone(paste0(
param3$TADA.ResultSampleFractionText[1],
@@ -1940,16 +1824,13 @@ TADA_DepthProfilePlot <- function(
}
# add horizontal lines for depth profile category
- if (depthcat == TRUE & is.null(surfacevalue) & is.null(bottomvalue)) {
+ if (isTRUE(depthcat) && is.na(surfacevalue) && is.na(bottomvalue)) {
stop(
- "TADA_DepthProfilePlot: No depth categories can be determined when both surfacevalue and bottomvalue are null. Supply one or both of these values and run the function again."
+ "TADA_DepthProfilePlot: No depth categories can be determined when both surfacevalue and bottomvalue are NA. Supply one or both values and run the function again."
)
}
-
- if (
- (depthcat == TRUE & !is.null(surfacevalue)) |
- (depthcat == TRUE & !is.null(bottomvalue))
- ) {
+
+ if (isTRUE(depthcat) && (!is.na(surfacevalue) || !is.na(bottomvalue))) {
# create list to store depth annotation text
depth_annotations <- list()
@@ -1996,43 +1877,41 @@ TADA_DepthProfilePlot <- function(
}
if (is.numeric(bottomvalue)) {
- # find bottom depth
- bot.depth <- plot.data |>
- dplyr::select(TADA.ConsolidatedDepth.Bottom) |>
- unique() |>
- dplyr::slice_max(TADA.ConsolidatedDepth.Bottom) |>
- dplyr::pull()
-
- message("TADA_DepthProfilePlot: Adding bottom delination to figure.")
-
- scatterplot <- scatterplot |>
- plotly::add_lines(
- y = bot.depth - bottomvalue,
- x = xrange,
- inherit = FALSE,
- showlegend = FALSE,
- line = list(color = tada.pal[1]),
- hoverinfo = "text",
- hovertext = paste(
- round((bot.depth - bottomvalue), digits = 1),
- fig.depth.unit,
- sep = " "
+ # find bottom depth robustly; skip annotation if no finite bottom
+ bot.depth <- suppressWarnings(max(plot.data$TADA.ConsolidatedDepth.Bottom, na.rm = TRUE))
+ if (is.finite(bot.depth)) {
+ message("TADA_DepthProfilePlot: Adding bottom delineation to figure.")
+ scatterplot <- scatterplot |>
+ plotly::add_lines(
+ y = bot.depth - bottomvalue,
+ x = xrange,
+ inherit = FALSE,
+ showlegend = FALSE,
+ line = list(color = tada.pal[1]),
+ hoverinfo = "text",
+ hovertext = paste(
+ round((bot.depth - bottomvalue), digits = 1),
+ fig.depth.unit,
+ sep = " "
+ )
)
+
+ bottom_text <- list(
+ x = 1,
+ y = (ymax + (bot.depth - bottomvalue)) / 2,
+ xref = "paper",
+ yref = "y",
+ text = "Bottom",
+ showarrow = F,
+ align = "right",
+ xanchor = "left",
+ yanchor = "center"
)
-
- bottom_text <- list(
- x = 1,
- y = (ymax + (bot.depth - bottomvalue)) / 2,
- xref = "paper",
- yref = "y",
- text = "Bottom",
- showarrow = F,
- align = "right",
- xanchor = "left",
- yanchor = "center"
- )
-
- depth_annotations <- append(depth_annotations, list(bottom_text))
+
+ depth_annotations <- append(depth_annotations, list(bottom_text))
+ } else {
+ message("TADA_DepthProfilePlot: Bottom depth is not available; bottom delineation omitted.")
+ }
}
if (is.numeric(surfacevalue) & is.numeric(bottomvalue)) {
From c9cbcd58b1d412042f019af9817a7e3ad6460bf9 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Tue, 28 Apr 2026 13:59:22 -0400
Subject: [PATCH 20/23] Update depth functions
---
R/DepthProfile.R | 602 ++++++++++++++++------------------
man/TADA_DepthProfilePlot.Rd | 20 +-
man/TADA_FlagDepthCategory.Rd | 21 +-
man/TADA_IDDepthProfiles.Rd | 6 +-
4 files changed, 314 insertions(+), 335 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 765f76733..8e76039be 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -57,22 +57,23 @@
#' @param aggregatedonly Boolean argument with options TRUE or FALSE. The
#' default is aggregatedonly = FALSE which means that all results are returned.
#' When aggregatedonly = TRUE, only aggregate values are returned.
+#' Note: aggregatedonly = TRUE has no effect when dailyagg = "none" and will raise an error
+#' (no aggregates to return).
#'
#' @param clean Boolean argument with options TRUE or FALSE. The
#' default is clean = FALSE which means that all results are returned.
#' When clean = TRUE, only aggregate results which can be assigned to a depth
#' category are included in the returned dataframe.
#'
-#' @param .data TADA dataframe
-#'
#' @return The same input TADA dataframe with additional columns TADA.DepthCategory.Flag,
#' TADA.DepthProfileAggregation.Flag, TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Bottom,
#' and TADA.ConsolidatedDepth.Unit. The consolidated depth fields are created by reviewing
-#' multiple WQC columns where users may input depth information. If a daily_agg = "avg",
-#' "min", or "max", aggregated values will be identified in the TADA.ResultAggregation.Flag
-#' column. In the case of daily_agg = "avg", additional rows to display averages will be
-#' added to the data frame. They can be identified by the prefix ("TADA-") of
-#' their result identifiers.
+#' multiple WQC columns where users may input depth information. If dailyagg = "avg",
+#' "min", or "max", aggregation status is described in TADA.DepthProfileAggregation.Flag.
+#' In the case of dailyagg = "avg", additional rows to display averages will be
+#' added to the data frame. Aggregated rows are identified by ResultIdentifier prefixed
+#' with "TADA-". When dailyagg = "avg", the aggregated result retains metadata from a
+#' deterministically selected representative record (first by ResultIdentifier within the group).
#'
#' @export
#'
@@ -88,15 +89,15 @@
#' Data_6Tribs_5y_Mean <- TADA_FlagDepthCategory(Data_6Tribes_5y,
#' bycategory = "all", dailyagg = "avg", aggregatedonly = FALSE
#' )
-#'
+#'
TADA_FlagDepthCategory <- function(
- .data,
- bycategory = "no",
- bottomvalue = 2,
- surfacevalue = 2,
- dailyagg = "none",
- aggregatedonly = FALSE,
- clean = FALSE
+ .data,
+ bycategory = "no",
+ bottomvalue = 2,
+ surfacevalue = 2,
+ dailyagg = "none",
+ aggregatedonly = FALSE,
+ clean = FALSE
) {
# check .data is data.frame and has required columns
expected_cols <- c(
@@ -119,7 +120,17 @@ TADA_FlagDepthCategory <- function(
TADA_CheckType(aggregatedonly, "logical")
# check clean is boolean
TADA_CheckType(clean, "logical")
-
+ # additional input and enum validation
+ TADA_CheckType(.data, "data.frame", "Input object")
+ valid_bycategory <- c("no", "all", "surface", "middle", "bottom")
+ if (!bycategory %in% valid_bycategory) {
+ stop("TADA_FlagDepthCategory: bycategory must be one of: 'no', 'all', 'surface', 'middle', 'bottom'.")
+ }
+ valid_dailyagg <- c("none", "avg", "min", "max")
+ if (!dailyagg %in% valid_dailyagg) {
+ stop("TADA_FlagDepthCategory: dailyagg must be one of: 'none', 'avg', 'min', 'max'.")
+ }
+
# normalize 'null' and NULL inputs to NA_real_
if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
surfacevalue <- NA_real_
@@ -133,7 +144,7 @@ TADA_FlagDepthCategory <- function(
if (is.null(bottomvalue)) {
bottomvalue <- NA_real_
}
-
+
# validate types if provided
if (!is.na(surfacevalue) && !is.numeric(surfacevalue)) {
stop(
@@ -145,11 +156,11 @@ TADA_FlagDepthCategory <- function(
"TADA_FlagDepthCategory: bottomvalue must be numeric, NULL, or 'null'."
)
}
-
+
# execute function after checks are passed
-
+
depthcat.list <- c("Surface", "Bottom", "Middle")
-
+
ard.ref <- utils::read.csv(system.file(
"extdata",
"TADAActivityRelativeDepthRef.csv",
@@ -160,48 +171,43 @@ TADA_FlagDepthCategory <- function(
ActivityRelativeDepthName = Name
) |>
dplyr::select(ARD_Category, ActivityRelativeDepthName)
-
+
depth.count <- .data |>
dplyr::filter(
!is.na(TADA.ActivityDepthHeightMeasure.MeasureValue) |
!is.na(TADA.ResultDepthHeightMeasure.MeasureValue)
) |>
nrow()
-
- length.units <- c("M", "FT", "IN")
-
- depth.params <- c(
- "DEPTH, SECCHI DISK DEPTH",
- "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
- "DEPTH, SECCHI DISK DEPTH REAPPEARS",
- "TRANSPARENCY, SECCHI TUBE WITH DISK",
- "DEPTH, DATA-LOGGER (NON-PORTED)",
- "DEPTH, DATA-LOGGER (PORTED)",
- "RBP STREAM DEPTH - RIFFLE",
- "RBP STREAM DEPTH - RUN",
- "THALWEG DEPTH"
- )
-
+
+ # derive cattype after bycategory validation
if (bycategory == "no") {
cattype <- "for the entire depth profile"
}
-
if (bycategory == "all") {
cattype <- "for each depth category"
}
-
if (bycategory == "bottom") {
cattype <- "for Bottom"
}
-
if (bycategory == "middle") {
cattype <- "for Middle"
}
-
if (bycategory == "surface") {
cattype <- "for Surface"
}
-
+
+ depth.params <- c(
+ "DEPTH, SECCHI DISK DEPTH",
+ "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
+ "DEPTH, SECCHI DISK DEPTH REAPPEARS",
+ "TRANSPARENCY, SECCHI TUBE WITH DISK",
+ "DEPTH, DATA-LOGGER (NON-PORTED)",
+ "DEPTH, DATA-LOGGER (PORTED)",
+ "RBP STREAM DEPTH - RIFFLE",
+ "RBP STREAM DEPTH - RUN",
+ "THALWEG DEPTH"
+ )
+
if (depth.count > 0) {
message(paste(
"TADA_FlagDepthCategory: checking data set for depth values. ",
@@ -209,9 +215,9 @@ TADA_FlagDepthCategory <- function(
" results have depth values available.",
sep = ""
))
-
+
message("TADA_FlagDepthCategory: assigning depth categories.")
-
+
# 1) Consolidate depth and units first
.data <- .data |>
dplyr::mutate(
@@ -239,19 +245,19 @@ TADA_FlagDepthCategory <- function(
),
TADA.ConsolidatedDepth.Unit = tolower(TADA.ConsolidatedDepth.Unit)
)
-
+
# 2) Validate there is only one depth unit in use (assumes conversion already done)
units_present <- .data |>
dplyr::filter(!is.na(TADA.ConsolidatedDepth.Unit)) |>
dplyr::pull(TADA.ConsolidatedDepth.Unit) |>
unique()
-
+
if (length(units_present) > 1) {
stop(
"TADA_FlagDepthCategory: Multiple depth units detected. Convert depth units to a single unit before categorizing."
)
}
-
+
# 3) Proceed to compute bottom depth and assign categories (NA-aware)
# use group_by to identify profile data
.data <- .data |>
@@ -287,15 +293,15 @@ TADA_FlagDepthCategory <- function(
!is.na(surfacevalue) &
!is.na(TADA.ConsolidatedDepth) &
TADA.ConsolidatedDepth <= surfacevalue ~ "Surface",
-
+
# Bottom only if bottomvalue and bottom depth are available
!is.na(bottomvalue) &
!is.na(TADA.ConsolidatedDepth.Bottom) &
!is.na(TADA.ConsolidatedDepth) &
TADA.ConsolidatedDepth >=
- (TADA.ConsolidatedDepth.Bottom - bottomvalue) &
+ (TADA.ConsolidatedDepth.Bottom - bottomvalue) &
TADA.ConsolidatedDepth <= TADA.ConsolidatedDepth.Bottom ~ "Bottom",
-
+
# Middle only if both surfacevalue and bottomvalue are provided (and bottom available)
!is.na(surfacevalue) &
!is.na(bottomvalue) &
@@ -303,8 +309,8 @@ TADA_FlagDepthCategory <- function(
!is.na(TADA.ConsolidatedDepth) &
TADA.ConsolidatedDepth > surfacevalue &
TADA.ConsolidatedDepth <
- (TADA.ConsolidatedDepth.Bottom - bottomvalue) ~ "Middle",
-
+ (TADA.ConsolidatedDepth.Bottom - bottomvalue) ~ "Middle",
+
TRUE ~ NA_character_
)
) |>
@@ -332,12 +338,12 @@ TADA_FlagDepthCategory <- function(
) |>
dplyr::select(-ARD_Category, -DepthsPerGroup)
}
-
+
if (depth.count == 0) {
message(
"TADA_FlagDepthCategory: No depth information was found in the dataset. The columns TADA.DepthCategory.Flag and TADA.ConsolidatedDepth are being added and populated with NA values."
)
-
+
.data <- .data |>
dplyr::mutate(
TADA.DepthCategory.Flag = NA_character_,
@@ -346,23 +352,23 @@ TADA_FlagDepthCategory <- function(
TADA.ConsolidatedDepth.Bottom = as.numeric(NA)
) |>
TADA_OrderCols()
-
+
return(.data)
}
-
+
if (clean == TRUE) {
.data <- .data |> dplyr::filter(TADA.DepthCategory.Flag %in% depthcat.list)
}
-
+
if (clean == FALSE) {
.data <- .data
}
-
+
if (bycategory == "all") {
message(
"TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, ActivityStartDate, and TADA.DepthCategory.Flag for aggregation by TADA.DepthCategory.Flag."
)
-
+
group.list <- c(
"TADA.MonitoringLocationIdentifier",
"OrganizationIdentifier",
@@ -370,73 +376,45 @@ TADA_FlagDepthCategory <- function(
"ActivityStartDate",
"TADA.DepthCategory.Flag"
)
-
- .data <- .data
- }
-
- if (bycategory == "no") {
- message(
- "TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for entire water column."
- )
-
- group.list <- c(
- "TADA.MonitoringLocationIdentifier",
- "OrganizationIdentifier",
- "TADA.CharacteristicName",
- "ActivityStartDate"
- )
-
+
.data <- .data
- }
-
- if (bycategory == "surface") {
- message(
- "TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for surface samples only."
- )
-
- group.list <- c(
- "TADA.MonitoringLocationIdentifier",
- "OrganizationIdentifier",
- "TADA.CharacteristicName",
- "ActivityStartDate"
- )
-
- .data <- .data |> dplyr::filter(TADA.DepthCategory.Flag == "Surface")
- }
-
- if (bycategory == "middle") {
- message(
- "TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for middle samples only."
- )
-
- group.list <- c(
- "TADA.MonitoringLocationIdentifier",
- "OrganizationIdentifier",
- "TADA.CharacteristicName",
- "ActivityStartDate"
- )
-
- .data <- .data |> dplyr::filter(TADA.DepthCategory.Flag == "Middle")
- }
-
- if (bycategory == "bottom") {
- message(
- "TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for bottom samples only."
- )
-
+ } else {
+ # unify grouping branches
+ if (bycategory == "no") {
+ message(
+ "TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for entire water column."
+ )
+ .data <- .data
+ }
+ if (bycategory == "surface") {
+ message(
+ "TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for surface samples only."
+ )
+ .data <- .data |> dplyr::filter(TADA.DepthCategory.Flag == "Surface")
+ }
+ if (bycategory == "middle") {
+ message(
+ "TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for middle samples only."
+ )
+ .data <- .data |> dplyr::filter(TADA.DepthCategory.Flag == "Middle")
+ }
+ if (bycategory == "bottom") {
+ message(
+ "TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for bottom samples only."
+ )
+ .data <- .data |> dplyr::filter(TADA.DepthCategory.Flag == "Bottom")
+ }
group.list <- c(
"TADA.MonitoringLocationIdentifier",
"OrganizationIdentifier",
"TADA.CharacteristicName",
"ActivityStartDate"
)
-
- .data <- .data |> dplyr::filter(TADA.DepthCategory.Flag == "Bottom")
}
-
+
if (dailyagg == "none") {
message("TADA_FlagDepthCategory: No aggregation performed.")
-
+
# add TADA.ResultValue.Aggregation.Flag, remove unecessary columns, and order columns
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -453,22 +431,22 @@ TADA_FlagDepthCategory <- function(
dplyr::select(-DepthsByGroup) |>
dplyr::ungroup() |>
TADA_OrderCols()
-
+
if (aggregatedonly == TRUE) {
stop(
"aggregatedonly = TRUE requires dailyagg = 'avg', 'min' or 'max'; nothing to return when dailyagg = 'none'."
)
}
-
+
if (aggregatedonly == FALSE) {
return(orig.data)
}
}
if ((dailyagg == "avg")) {
message(
- "TADA_FlagDepthCategory: Calculating mean aggregate value with randomly selected metadata."
+ "TADA_FlagDepthCategory: Calculating mean aggregate value with deterministically selected metadata."
)
-
+
# add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -491,8 +469,8 @@ TADA_FlagDepthCategory <- function(
TADA.DepthProfileAggregation.Flag
)
)
-
- # add TADA.ResultValue.Aggregation.Flag, remove necessary columns, calculate mean result value per group, and assign random metadata from group.
+
+ # add TADA.ResultValue.Aggregation.Flag, remove necessary columns, calculate mean result value per group, and assign deterministic metadata from group.
agg.data <- orig.data |>
dplyr::filter(
DepthsByGroup > 1,
@@ -501,40 +479,42 @@ TADA_FlagDepthCategory <- function(
dplyr::mutate(
TADA.ResultMeasureValue1 = mean(TADA.ResultMeasureValue, na.rm = TRUE)
) |>
- dplyr::slice_sample(n = 1) |>
+ # choose a deterministic representative row for reproducibility
+ dplyr::arrange(ResultIdentifier) |>
+ dplyr::slice(1) |>
dplyr::mutate(
TADA.DepthProfileAggregation.Flag = paste0(
"Calculated mean aggregate value ",
cattype,
- ", with randomly selected metadata from a row in the aggregate group"
+ ", with deterministically selected metadata from a row in the aggregate group"
)
) |>
dplyr::select(-TADA.ResultMeasureValue, -DepthsByGroup) |>
dplyr::rename(TADA.ResultMeasureValue = TADA.ResultMeasureValue1) |>
dplyr::mutate(ResultIdentifier = paste0("TADA-", ResultIdentifier)) |>
dplyr::ungroup()
-
+
if (aggregatedonly == TRUE) {
rm(orig.data)
-
+
return(agg.data)
}
-
+
if (aggregatedonly == FALSE) {
# combine original and aggregate data
comb.data <- dplyr::bind_rows(orig.data, agg.data) |>
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
-
+
rm(agg.data, orig.data)
-
+
return(comb.data)
}
}
if ((dailyagg == "min")) {
message("TADA_FlagDepthCategory: Selecting minimum aggregate value.")
-
+
# add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -557,7 +537,7 @@ TADA_FlagDepthCategory <- function(
TADA.DepthProfileAggregation.Flag
)
)
-
+
# add TADA.ResultValue.Aggregation.Flag, remove necessary columns, and select minimum result value per group.
agg.data <- orig.data |>
dplyr::filter(
@@ -577,13 +557,13 @@ TADA_FlagDepthCategory <- function(
) |>
dplyr::select(-DepthsByGroup) |>
dplyr::ungroup()
-
+
if (aggregatedonly == TRUE) {
rm(orig.data)
-
+
return(agg.data)
}
-
+
if (aggregatedonly == FALSE) {
# create list of result identifiers for selected aggregate data
agg.list <- agg.data |>
@@ -591,7 +571,7 @@ TADA_FlagDepthCategory <- function(
dplyr::select(ResultIdentifier) |>
unique() |>
dplyr::pull()
-
+
# combine original and aggregate data
comb.data <- orig.data |>
dplyr::filter(!ResultIdentifier %in% agg.list) |>
@@ -599,16 +579,16 @@ TADA_FlagDepthCategory <- function(
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
-
+
rm(agg.data, orig.data, agg.list)
-
+
return(comb.data)
}
}
-
+
if ((dailyagg == "max")) {
message("TADA_FlagDepthCategory: Selecting maximum aggregate value.")
-
+
# Flag all rows (in groups with >1 depth) as considered/not selected by default
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -632,7 +612,7 @@ TADA_FlagDepthCategory <- function(
TADA.DepthProfileAggregation.Flag
)
)
-
+
# Select the maximum result per group (only rows in depth categories)
agg.data <- orig.data |>
dplyr::filter(
@@ -652,12 +632,12 @@ TADA_FlagDepthCategory <- function(
) |>
dplyr::select(-DepthsByGroup) |>
dplyr::ungroup()
-
+
if (aggregatedonly == TRUE) {
rm(orig.data)
return(agg.data)
}
-
+
if (aggregatedonly == FALSE) {
# Remove the selected rows from the original so they are not duplicated,
# then add them back with the "selected" flag applied above
@@ -666,21 +646,20 @@ TADA_FlagDepthCategory <- function(
dplyr::select(ResultIdentifier) |>
unique() |>
dplyr::pull()
-
+
comb.data <- orig.data |>
dplyr::filter(!ResultIdentifier %in% agg.list) |>
dplyr::bind_rows(agg.data) |>
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
-
+
rm(agg.data, orig.data, agg.list)
return(comb.data)
}
}
}
-
#' TADA_IDDepthProfiles
#'
#' This function identifies depth profiles within a data frame to assist the user in
@@ -703,7 +682,8 @@ TADA_FlagDepthCategory <- function(
#' @param nresults Boolean argument with options "TRUE" or "FALSE". The
#' default is nresults = TRUE, which means that the number of results for each
#' characteristic are added within the TADA.CharacteristicsForDepthProfile column.
-#' When nresults = FALSE.
+#' When nresults = FALSE, the number of results is not appended to
+#' TADA.CharacteristicsForDepthProfile.
#'
#' @param nvalue numeric argument to specify the number of results required to identify
#' a depth profile. The default is 2, which means that a depth profile will be identified
@@ -726,6 +706,10 @@ TADA_FlagDepthCategory <- function(
#' param, TADA.CharacteristicsForDepthProfile may or may not contain the number
#' of results for each characteristic.
#'
+#' @details
+#' Inputs nresults and aggregates must be logical scalars; non-logical values will
+#' raise an error. nvalue must be a single numeric value.
+#'
#' @export
#'
#' @examples
@@ -738,13 +722,21 @@ TADA_FlagDepthCategory <- function(
#'
#' # find depth profile data showing number of results
#' Data_6Tribes_5y_DepthProfileID <- TADA_IDDepthProfiles(Data_6Tribes_5y)
-#'
+#'
TADA_IDDepthProfiles <- function(
- .data,
- nresults = TRUE,
- nvalue = 2,
- aggregates = FALSE
+ .data,
+ nresults = TRUE,
+ nvalue = 2,
+ aggregates = FALSE
) {
+ # input type validation
+ TADA_CheckType(.data, "data.frame", "Input object")
+ TADA_CheckType(nresults, "logical", "nresults")
+ TADA_CheckType(aggregates, "logical", "aggregates")
+ if (!is.numeric(nvalue) || length(nvalue) != 1) {
+ stop("TADA_IDDepthProfiles: nvalue must be a single numeric value.")
+ }
+
# check for columns created in TADA_FlagDepthCategory and run the function if they are missing
# add check that depth category flag function has been run, run it if it has not
flag.func.cols <- c(
@@ -754,7 +746,7 @@ TADA_IDDepthProfiles <- function(
"TADA.DepthCategory.Flag",
"TADA.DepthProfileAggregation.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
message(
"TADA_IDDepthProfiles: Necessary columns from TADA_FlagDepthCategory function are included in the data frame."
@@ -766,7 +758,7 @@ TADA_IDDepthProfiles <- function(
)
.data <- TADA_FlagDepthCategory(.data)
}
-
+
depth.params <- c(
"DEPTH, SECCHI DISK DEPTH",
"DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
@@ -778,12 +770,12 @@ TADA_IDDepthProfiles <- function(
"RBP STREAM DEPTH - RUN",
"THALWEG DEPTH"
)
-
+
# when aggregates == FALSE, robust removal of mean-aggregated rows (created by avg)
if (!aggregates && "ResultIdentifier" %in% names(.data)) {
.data <- dplyr::filter(.data, !grepl("^TADA-", ResultIdentifier))
}
-
+
if (nresults == TRUE) {
.data <- .data |>
dplyr::select(
@@ -854,11 +846,11 @@ TADA_IDDepthProfiles <- function(
TADA.CharacteristicsForDepthProfile
) |>
unique()
-
+
return(.data)
}
-
- if (nresults == FALSE) {
+
+ if (identical(nresults, FALSE)) {
.data <- .data |>
dplyr::select(
TADA.MonitoringLocationIdentifier,
@@ -920,9 +912,12 @@ TADA_IDDepthProfiles <- function(
TADA.CharacteristicsForDepthProfile
) |>
unique()
-
+
return(.data)
}
+
+ # ensure function doesn’t fall through silently
+ stop("TADA_IDDepthProfiles: nresults must be TRUE or FALSE.")
}
#' Create A Three-Characteristic Depth Profile
@@ -935,35 +930,43 @@ TADA_IDDepthProfiles <- function(
#' must be the same. This can be accomplished using TADA_AutoClean() or
#' TADA_ConvertDepthUnits.
#'
-#' @param groups A vector of two identifiers from the TADA.ComparableDataIdentifier column.
-#' For example, the groups could be 'DISSOLVED OXYGEN (DO)_NA_NA_UG/L' and 'PH_NA_NA_NA'.
-#' These groups will be specific to your data frame. The TADA_IDDepthProfiles can be
-#' used to identify available groups.
+#' @param groups A vector of up to three identifiers from the TADA.ComparableDataIdentifier column.
+#' For example, the groups could be 'DISSOLVED OXYGEN (DO)_NA_NA_UG/L' and 'PH_NA_NA_NA'.
+#' These groups will be specific to your data frame. The TADA_IDDepthProfiles can be
+#' used to identify available groups. If more than three identifiers are supplied,
+#' only the first three are used and a warning is issued.
#'
#' @param location A single TADA.MonitoringLocationIdentifier to plot the depth profile.
-#' A TADA.MonitoringLocationIdentifier must be entered or an error will be returned and
-#' no depth profile will be created.
+#' A TADA.MonitoringLocationIdentifier must be entered or an error will be returned and
+#' no depth profile will be created.
#'
#' @param activity_date The date the depth profile results were collected.
#'
#' @param depthcat Boolean argument indicating whether delineation between depth
-#' categories should be shown on the depth profile figure. depthcat = TRUE is the
-#' default and displays solid black lines to delineate between surface, middle, and
-#' bottom samples and labels each section of the plot.
+#' categories should be shown on the depth profile figure. depthcat = TRUE is the
+#' default and displays solid black lines to delineate between surface, middle, and
+#' bottom samples and labels each section of the plot.
+#' When depthcat = TRUE, at least one of surfacevalue or bottomvalue must be provided
+#' (non-NA), otherwise the function will stop. If bottom depth cannot be determined for
+#' the selection, “Bottom” and “Middle” delineations are omitted.
#'
#' @param bottomvalue numeric argument. The user enters how many meters from the
-#' bottom should be included in the "Bottom" category. Default is
-#' bottomvalue = 2.
+#' bottom should be included in the "Bottom" category. Default is
+#' bottomvalue = 2.
#'
#' @param surfacevalue numeric argument. The user enters how many meters from the
-#' surface should be included in the "Surface" category. Default is surfacevalue = 2.
+#' surface should be included in the "Surface" category. Default is surfacevalue = 2.
#'
-#' @param unit Character argument. The enters either "m" or "ft" to specify which
-#' depth units should be used for the plot. Default is "m".
+#' @param unit Character argument. The user enters either "m" or "ft" to specify which
+#' depth units should be used for the plot. Default is "m".
+#' Non-depth-parameter rows must already be in the specified unit. Depth-parameter
+#' rows (e.g., Secchi) are converted to the specified unit for plotting when necessary.
#'
#' @return A depth profile plot displaying up to three parameters for a single
-#' TADA.MonitoringLocationIdentifier. Displaying depth categories is optional with the
-#' depthcat argument.
+#' TADA.MonitoringLocationIdentifier. Displaying depth categories is optional with the
+#' depthcat argument. The function excludes duplicate depth-parameter rows from the
+#' main profile series and, if any are included via groups, plots them as single
+#' horizontal reference lines in the requested unit.
#'
#' @export
#'
@@ -990,19 +993,19 @@ TADA_IDDepthProfiles <- function(
#' groups = c("PH_NONE_NONE_NONE", "DISSOLVED OXYGEN (DO)_NONE_NONE_MG/L"),
#' location = "REDLAKE_WQX-JOHN",
#' activity_date = "2018-07-31",
-#'depthcat = FALSE
+#' depthcat = FALSE
#' )
#' }
-#'
+#'
TADA_DepthProfilePlot <- function(
- .data,
- groups = NULL,
- location = NULL,
- activity_date = NULL,
- depthcat = TRUE,
- surfacevalue = 2,
- bottomvalue = 2,
- unit = "m"
+ .data,
+ groups = NULL,
+ location = NULL,
+ activity_date = NULL,
+ depthcat = TRUE,
+ surfacevalue = 2,
+ bottomvalue = 2,
+ unit = "m"
) {
# check to see if TADA.ComparableDataIdentifier column is present
if (!"TADA.ComparableDataIdentifier" %in% colnames(.data)) {
@@ -1010,10 +1013,18 @@ TADA_DepthProfilePlot <- function(
"TADA.ComparableDataIdentifier column not present in data set. Run TADA_CreateComparableID to create TADA.ComparableDataIdentifier."
)
}
-
+
# check .data is data.frame
TADA_CheckType(.data, "data.frame", "Input object")
-
+ # validate unit and groups length
+ if (!unit %in% c("m", "ft")) {
+ stop("TADA_DepthProfilePlot: unit must be 'm' or 'ft'.")
+ }
+ if (length(groups) > 3) {
+ warning("TADA_DepthProfilePlot: More than 3 groups supplied; only the first 3 will be used.")
+ groups <- groups[1:3]
+ }
+
# Normalize "null" to NA
if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
surfacevalue <- NA_real_
@@ -1021,7 +1032,7 @@ TADA_DepthProfilePlot <- function(
if (is.character(bottomvalue) && tolower(bottomvalue) == "null") {
bottomvalue <- NA_real_
}
-
+
# Add check that depth category flag function has been run, run it if it has not
flag.func.cols <- c(
"TADA.ConsolidatedDepth",
@@ -1029,7 +1040,7 @@ TADA_DepthProfilePlot <- function(
"TADA.ConsolidatedDepth.Bottom",
"TADA.DepthCategory.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data))) {
message(
"TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame"
@@ -1039,7 +1050,7 @@ TADA_DepthProfilePlot <- function(
message(
"TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame"
)
-
+
if (is.na(surfacevalue) && is.na(bottomvalue)) {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1081,15 +1092,15 @@ TADA_DepthProfilePlot <- function(
)
}
}
-
+
# Define depth-parameter characteristics (needed before unit checks)
depth.params <- c(
"DEPTH, SECCHI DISK DEPTH",
"DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
"DEPTH, SECCHI DISK DEPTH REAPPEARS",
+ "TRANSPARENCY, SECCHI TUBE WITH DISK",
"DEPTH, DATA-LOGGER (NON-PORTED)",
"DEPTH, DATA-LOGGER (PORTED)",
- "TRANSPARENCY, SECCHI TUBE WITH DISK",
"RBP STREAM DEPTH - RIFFLE",
"RBP STREAM DEPTH - RUN",
"THALWEG DEPTH"
@@ -1109,11 +1120,10 @@ TADA_DepthProfilePlot <- function(
} else {
message("TADA_DepthProfilePlot: Only depth-parameter rows detected; unit check skipped (conversion will be applied as needed).")
}
-
+
# create ID Depth Profiles data.frame to check against params
-
param.check <- TADA_IDDepthProfiles(.data)
-
+
# Early required-argument checks
if (is.null(location) || is.null(activity_date) || is.null(groups)) {
stop("TADA_DepthProfilePlot: Please supply 'location', 'activity_date', and 'groups'.")
@@ -1133,10 +1143,10 @@ TADA_DepthProfilePlot <- function(
paste(missing_groups, collapse = ", ")
))
}
-
+
# remove param.check
rm(param.check)
-
+
# Ensure optional datetime column exists for hover text
if (!"ActivityStartDateTime" %in% names(.data)) {
.data$ActivityStartDateTime <- NA_character_
@@ -1166,18 +1176,20 @@ TADA_DepthProfilePlot <- function(
"TADA.MethodSpeciationName",
"TADA.ResultSampleFractionText"
)
-
+
# check .data has required columns
TADA_CheckColumns(.data, required_cols)
-
+
message("TADA_DepthProfilePlot: Identifying available depth profile data.")
-
+
+ # exclude depth-parameter rows from depthprofile.avail to avoid duplication
depthprofile.avail <- .data |>
dplyr::filter(
!is.na(TADA.ConsolidatedDepth),
TADA.MonitoringLocationIdentifier %in% location,
ActivityStartDate %in% activity_date,
- TADA.ActivityMediaName == "WATER"
+ TADA.ActivityMediaName == "WATER",
+ !TADA.CharacteristicName %in% depth.params
) |>
dplyr::group_by(
TADA.ComparableDataIdentifier,
@@ -1192,48 +1204,36 @@ TADA_DepthProfilePlot <- function(
ActivityStartDate
) |>
dplyr::mutate(N = length(TADA.ResultMeasureValue)) |>
- dplyr::filter(N > 2 | TADA.CharacteristicName %in% depth.params) |>
+ dplyr::filter(N > 2) |>
dplyr::ungroup() |>
dplyr::select(-N)
-
- depth.params.groups <- depthprofile.avail |>
+
+ depth.params.groups <- .data |>
dplyr::filter(
- TADA.ComparableDataIdentifier %in% groups,
+ TADA.MonitoringLocationIdentifier %in% location,
+ ActivityStartDate %in% activity_date,
+ TADA.ActivityMediaName == "WATER",
TADA.CharacteristicName %in% depth.params
) |>
dplyr::select(TADA.ComparableDataIdentifier) |>
unique() |>
dplyr::pull()
-
+
# Use user-specified depth unit for the figure
fig.depth.unit <- unit
-
+
# if any depth parameter (ex: secchi) data
if (length(intersect(groups, depth.params.groups)) > 0) {
# add depth param (ex: secchi) results
depth.params.string <- paste(depth.params, collapse = "; ")
-
- depth.units <- c(
- "m",
- "ft",
- "in",
- "m",
- "m",
- "ft",
- "ft",
- "in",
- "in",
- "m",
- "ft",
- "in"
- )
-
+
depth.params.avail <- .data |>
dplyr::filter(
TADA.MonitoringLocationIdentifier %in% location,
TADA.CharacteristicName %in% depth.params,
ActivityStartDate %in% activity_date,
- TADA.ActivityMediaName == "WATER"
+ TADA.ActivityMediaName == "WATER",
+ TADA.ComparableDataIdentifier %in% groups
) |>
dplyr::group_by(
TADA.CharacteristicName,
@@ -1242,7 +1242,7 @@ TADA_DepthProfilePlot <- function(
) |>
dplyr::slice_sample(n = 1) |>
dplyr::ungroup()
-
+
units_match <- all(stats::na.omit(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit)
if (units_match) {
message(paste(
@@ -1256,64 +1256,24 @@ TADA_DepthProfilePlot <- function(
depth.params.string,
"results to match depth units selected for the figure."
))
-
- depth.units <- c(
- "m",
- "ft",
- "in",
- "m",
- "m",
- "ft",
- "ft",
- "in",
- "in",
- "m",
- "ft",
- "in"
- )
- result.units <- c(
- "m",
- "ft",
- "in",
- "ft",
- "in",
- "m",
- "in",
- "m",
- "ft",
- "cm",
- "cm",
- "cm"
- )
- convert.factor <- c(
- "1",
- "1",
- "1",
- "0.3048",
- "0.0254",
- "3.281",
- "0.083",
- "39.3701",
- "12",
- "0.01",
- "0.032808",
- "0.39"
+
+ # consolidated conversion map for depth-parameter rows
+ conv_df <- data.frame(
+ TADA.ConsolidatedDepth.Unit = c(
+ "m","ft","in","ft","in","m","in","m","ft","cm","cm","cm"
+ ),
+ YAxis.DepthUnit = c(
+ "m","m","m","ft","ft","ft","ft","in","in","m","ft","in"
+ ),
+ SecchiConversion = c(
+ "1","0.3048","0.0254","3.281","0.083","39.3701","12","0.01","0.032808","0.39","0.39","0.39"
+ ),
+ stringsAsFactors = FALSE
)
-
- secchi.conversion <- data.frame(
- result.units,
- depth.units,
- convert.factor
- ) |>
- dplyr::rename(
- TADA.ConsolidatedDepth.Unit = result.units,
- YAxis.DepthUnit = depth.units,
- SecchiConversion = convert.factor
- )
-
+
depth.params.avail <- depth.params.avail |>
dplyr::mutate(YAxis.DepthUnit = fig.depth.unit) |>
- dplyr::left_join(secchi.conversion) |>
+ dplyr::left_join(conv_df, by = c("TADA.ConsolidatedDepth.Unit", "YAxis.DepthUnit")) |>
dplyr::mutate(
TADA.ConsolidatedDepth.Unit = fig.depth.unit,
TADA.ConsolidatedDepth = TADA.ResultMeasureValue *
@@ -1321,7 +1281,7 @@ TADA_DepthProfilePlot <- function(
) |>
dplyr::select(-YAxis.DepthUnit, -SecchiConversion)
}
-
+
profile.data <- dplyr::bind_rows(depthprofile.avail, depth.params.avail)
rm(depth.params.avail, depthprofile.avail)
} else {
@@ -1348,9 +1308,9 @@ TADA_DepthProfilePlot <- function(
if (nrow(plot.data) == 0) {
stop("TADA_DepthProfilePlot: No data found for the selected location, activity_date, and groups.")
}
-
+
rm(profile.data)
-
+
# break into subsets for each parameter
param1 <- plot.data |>
dplyr::filter(TADA.ComparableDataIdentifier %in% groups[1])
@@ -1370,9 +1330,9 @@ TADA_DepthProfilePlot <- function(
paste(missing_in_subset, collapse = ", ")
))
}
-
+
# create title for figure, conditional on number of groups/characteristics selected
-
+
# title for three characteristics
if (length(groups) == 3) {
title <- stringr::str_wrap(
@@ -1390,7 +1350,7 @@ TADA_DepthProfilePlot <- function(
width = 50
)
}
-
+
# title for two characteristics
if (length(groups) == 2) {
title <- stringr::str_wrap(
@@ -1407,7 +1367,7 @@ TADA_DepthProfilePlot <- function(
width = 50
)
}
-
+
# title for one characteristic
if (length(groups) == 1) {
title <- stringr::str_wrap(
@@ -1422,7 +1382,7 @@ TADA_DepthProfilePlot <- function(
width = 50
)
}
-
+
# figure margin
mrg <- list(
l = 50,
@@ -1431,19 +1391,19 @@ TADA_DepthProfilePlot <- function(
t = (25 + (ceiling(nchar(title) / 50)) * 25), # top margin is variable based on number of lines in title
pad = 0
)
-
+
# determine x + y max and range for plotting
xmax <- max(plot.data$TADA.ResultMeasureValue, na.rm = TRUE) +
0.5 * max(plot.data$TADA.ResultMeasureValue, na.rm = TRUE)
xrange <- c(0, xmax)
-
+
ymax <- max(plot.data$TADA.ConsolidatedDepth, na.rm = TRUE) +
0.1 * max(plot.data$TADA.ConsolidatedDepth, na.rm = TRUE)
yrange <- c(0, ymax)
-
+
# set palette
tada.pal <- TADA_ColorPalette()
-
+
# create base of scatter plot
scatterplot <- plotly::plot_ly(type = "scatter", mode = "lines+markers") |>
plotly::layout(
@@ -1485,12 +1445,12 @@ TADA_DepthProfilePlot <- function(
yanchor = "top"
)
)
-
+
# first parameter has a depth profile
if (
length(groups) >= 1 &&
- nrow(param1) > 0 &&
- !param1$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param1) > 0 &&
+ !param1$TADA.CharacteristicName[1] %in% depth.params
) {
# config options https://plotly.com/r/configuration-options/
scatterplot <- scatterplot |>
@@ -1543,7 +1503,7 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# first parameter has a single value where units are depth
if (
length(groups) >= 1 &&
@@ -1598,12 +1558,12 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# second parameter has a depth profile
if (
length(groups) >= 2 &&
- nrow(param2) > 0 &&
- !param2$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param2) > 0 &&
+ !param2$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_trace(
@@ -1654,7 +1614,7 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# second parameter has a single value where units are depth
if (
length(groups) >= 2 &&
@@ -1710,12 +1670,12 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# third parameter has a depth profile
if (
length(groups) >= 3 &&
- nrow(param3) > 0 &&
- !param3$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param3) > 0 &&
+ !param3$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_trace(
@@ -1766,7 +1726,7 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# third parameter has a single value where units are depth
if (
length(groups) >= 3 &&
@@ -1822,7 +1782,7 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# add horizontal lines for depth profile category
if (isTRUE(depthcat) && is.na(surfacevalue) && is.na(bottomvalue)) {
stop(
@@ -1833,7 +1793,7 @@ TADA_DepthProfilePlot <- function(
if (isTRUE(depthcat) && (!is.na(surfacevalue) || !is.na(bottomvalue))) {
# create list to store depth annotation text
depth_annotations <- list()
-
+
# adjust margins of plot
scatterplot <- scatterplot |>
plotly::layout(
@@ -1845,10 +1805,10 @@ TADA_DepthProfilePlot <- function(
pad = 0
)
)
-
+
if (is.numeric(surfacevalue)) {
message("TADA_DepthProfilePlot: Adding surface delination to figure.")
-
+
# add surface line
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1860,7 +1820,7 @@ TADA_DepthProfilePlot <- function(
hoverinfo = "text",
hovertext = paste(surfacevalue, fig.depth.unit, sep = " ")
)
-
+
surface_text <- list(
x = 1,
y = surfacevalue / 2,
@@ -1872,25 +1832,25 @@ TADA_DepthProfilePlot <- function(
xanchor = "left",
yanchor = "center"
)
-
+
depth_annotations <- append(depth_annotations, list(surface_text))
}
-
+
if (is.numeric(bottomvalue)) {
# find bottom depth robustly; skip annotation if no finite bottom
- bot.depth <- suppressWarnings(max(plot.data$TADA.ConsolidatedDepth.Bottom, na.rm = TRUE))
- if (is.finite(bot.depth)) {
+ bd <- suppressWarnings(max(plot.data$TADA.ConsolidatedDepth.Bottom, na.rm = TRUE))
+ if (is.finite(bd)) {
message("TADA_DepthProfilePlot: Adding bottom delineation to figure.")
scatterplot <- scatterplot |>
plotly::add_lines(
- y = bot.depth - bottomvalue,
+ y = bd - bottomvalue,
x = xrange,
inherit = FALSE,
showlegend = FALSE,
line = list(color = tada.pal[1]),
hoverinfo = "text",
hovertext = paste(
- round((bot.depth - bottomvalue), digits = 1),
+ round((bd - bottomvalue), digits = 1),
fig.depth.unit,
sep = " "
)
@@ -1898,7 +1858,7 @@ TADA_DepthProfilePlot <- function(
bottom_text <- list(
x = 1,
- y = (ymax + (bot.depth - bottomvalue)) / 2,
+ y = (ymax + (bd - bottomvalue)) / 2,
xref = "paper",
yref = "y",
text = "Bottom",
@@ -1913,11 +1873,11 @@ TADA_DepthProfilePlot <- function(
message("TADA_DepthProfilePlot: Bottom depth is not available; bottom delineation omitted.")
}
}
-
- if (is.numeric(surfacevalue) & is.numeric(bottomvalue)) {
+
+ if (is.numeric(surfacevalue) & is.numeric(bottomvalue) && is.finite(bd)) {
middle_text <- list(
x = 1,
- y = (surfacevalue + (bot.depth - bottomvalue)) / 2,
+ y = (surfacevalue + (bd - bottomvalue)) / 2,
xref = "paper",
yref = "y",
text = "Middle",
@@ -1926,14 +1886,14 @@ TADA_DepthProfilePlot <- function(
xanchor = "left",
yanchor = "center"
)
-
+
depth_annotations <- append(depth_annotations, list(middle_text))
}
-
+
scatterplot <- scatterplot |>
plotly::layout(annotations = depth_annotations)
}
-
+
# return plot with no depth profile category
if (depthcat == FALSE) {
scatterplot <- scatterplot
diff --git a/man/TADA_DepthProfilePlot.Rd b/man/TADA_DepthProfilePlot.Rd
index 508649eaa..c0c77608d 100644
--- a/man/TADA_DepthProfilePlot.Rd
+++ b/man/TADA_DepthProfilePlot.Rd
@@ -24,10 +24,11 @@ and TADA.ActivityDepthHeightMeasure.MeasureValue. Units for all depth fields
must be the same. This can be accomplished using TADA_AutoClean() or
TADA_ConvertDepthUnits.}
-\item{groups}{A vector of two identifiers from the TADA.ComparableDataIdentifier column.
+\item{groups}{A vector of up to three identifiers from the TADA.ComparableDataIdentifier column.
For example, the groups could be 'DISSOLVED OXYGEN (DO)_NA_NA_UG/L' and 'PH_NA_NA_NA'.
These groups will be specific to your data frame. The TADA_IDDepthProfiles can be
-used to identify available groups.}
+used to identify available groups. If more than three identifiers are supplied,
+only the first three are used and a warning is issued.}
\item{location}{A single TADA.MonitoringLocationIdentifier to plot the depth profile.
A TADA.MonitoringLocationIdentifier must be entered or an error will be returned and
@@ -38,7 +39,10 @@ no depth profile will be created.}
\item{depthcat}{Boolean argument indicating whether delineation between depth
categories should be shown on the depth profile figure. depthcat = TRUE is the
default and displays solid black lines to delineate between surface, middle, and
-bottom samples and labels each section of the plot.}
+bottom samples and labels each section of the plot.
+When depthcat = TRUE, at least one of surfacevalue or bottomvalue must be provided
+(non-NA), otherwise the function will stop. If bottom depth cannot be determined for
+the selection, “Bottom” and “Middle” delineations are omitted.}
\item{surfacevalue}{numeric argument. The user enters how many meters from the
surface should be included in the "Surface" category. Default is surfacevalue = 2.}
@@ -47,13 +51,17 @@ surface should be included in the "Surface" category. Default is surfacevalue =
bottom should be included in the "Bottom" category. Default is
bottomvalue = 2.}
-\item{unit}{Character argument. The enters either "m" or "ft" to specify which
-depth units should be used for the plot. Default is "m".}
+\item{unit}{Character argument. The user enters either "m" or "ft" to specify which
+depth units should be used for the plot. Default is "m".
+Non-depth-parameter rows must already be in the specified unit. Depth-parameter
+rows (e.g., Secchi) are converted to the specified unit for plotting when necessary.}
}
\value{
A depth profile plot displaying up to three parameters for a single
TADA.MonitoringLocationIdentifier. Displaying depth categories is optional with the
-depthcat argument.
+depthcat argument. The function excludes duplicate depth-parameter rows from the
+main profile series and, if any are included via groups, plots them as single
+horizontal reference lines in the requested unit.
}
\description{
Create A Three-Characteristic Depth Profile
diff --git a/man/TADA_FlagDepthCategory.Rd b/man/TADA_FlagDepthCategory.Rd
index 4c0e6717b..3f0aef7d4 100644
--- a/man/TADA_FlagDepthCategory.Rd
+++ b/man/TADA_FlagDepthCategory.Rd
@@ -15,7 +15,11 @@ TADA_FlagDepthCategory(
)
}
\arguments{
-\item{.data}{TADA dataframe}
+\item{.data}{TADA dataframe which must include the columns
+TADA.ActivityDepthHeightMeasure.MeasureValue,
+TADA.ResultDepthHeightMeasure.MeasureValue,
+TADA.ActivityBottomDepthHeightMeasure.MeasureValue, and
+ActivityRelativeDepthName.}
\item{bycategory}{character argument with options "no", "all", "surface", "middle",
"bottom". The default is bycategory = "no" which means that any aggregate values
@@ -52,7 +56,9 @@ be added to describe aggregation.}
\item{aggregatedonly}{Boolean argument with options TRUE or FALSE. The
default is aggregatedonly = FALSE which means that all results are returned.
-When aggregatedonly = TRUE, only aggregate values are returned.}
+When aggregatedonly = TRUE, only aggregate values are returned.
+Note: aggregatedonly = TRUE has no effect when dailyagg = "none" and will raise an error
+(no aggregates to return).}
\item{clean}{Boolean argument with options TRUE or FALSE. The
default is clean = FALSE which means that all results are returned.
@@ -63,11 +69,12 @@ category are included in the returned dataframe.}
The same input TADA dataframe with additional columns TADA.DepthCategory.Flag,
TADA.DepthProfileAggregation.Flag, TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Bottom,
and TADA.ConsolidatedDepth.Unit. The consolidated depth fields are created by reviewing
-multiple WQC columns where users may input depth information. If a daily_agg = "avg",
-"min", or "max", aggregated values will be identified in the TADA.ResultAggregation.Flag
-column. In the case of daily_agg = "avg", additional rows to display averages will be
-added to the data frame. They can be identified by the prefix ("TADA-") of
-their result identifiers.
+multiple WQC columns where users may input depth information. If dailyagg = "avg",
+"min", or "max", aggregation status is described in TADA.DepthProfileAggregation.Flag.
+In the case of dailyagg = "avg", additional rows to display averages will be
+added to the data frame. Aggregated rows are identified by ResultIdentifier prefixed
+with "TADA-". When dailyagg = "avg", the aggregated result retains metadata from a
+deterministically selected representative record (first by ResultIdentifier within the group).
}
\description{
This function creates a new column, TADA.DepthCategory.Flag with values: "No
diff --git a/man/TADA_IDDepthProfiles.Rd b/man/TADA_IDDepthProfiles.Rd
index 695628cae..1fccc8722 100644
--- a/man/TADA_IDDepthProfiles.Rd
+++ b/man/TADA_IDDepthProfiles.Rd
@@ -16,7 +16,8 @@ and TADA.ComparableDataIdentifier.}
\item{nresults}{Boolean argument with options "TRUE" or "FALSE". The
default is nresults = TRUE, which means that the number of results for each
characteristic are added within the TADA.CharacteristicsForDepthProfile column.
-When nresults = FALSE.}
+When nresults = FALSE, the number of results is not appended to
+TADA.CharacteristicsForDepthProfile.}
\item{nvalue}{numeric argument to specify the number of results required to identify
a depth profile. The default is 2, which means that a depth profile will be identified
@@ -52,6 +53,9 @@ A new column, TADA.CharacteristicsForDepthProfile, is created which lists the
characteristics available for depth profile analysis. Using the, nresults param,
users can specify whether characteristic names should be followed by the number
of results available for the characteristic in parentheses.
+
+Inputs nresults and aggregates must be logical scalars; non-logical values will
+raise an error. nvalue must be a single numeric value.
}
\examples{
# Load data frame
From 8267739748cb640df0af465d149c444d389835f4 Mon Sep 17 00:00:00 2001
From: "pre-commit-ci[bot]"
<66853113+pre-commit-ci[bot]@users.noreply.github.com>
Date: Tue, 28 Apr 2026 20:22:46 +0000
Subject: [PATCH 21/23] [pre-commit.ci] auto fixes from pre-commit.com hooks
for more information, see https://pre-commit.ci
---
R/DepthProfile.R | 407 +++++++++++++++++++++++++++--------------------
1 file changed, 235 insertions(+), 172 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 8e76039be..88f4d84d6 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -89,15 +89,15 @@
#' Data_6Tribs_5y_Mean <- TADA_FlagDepthCategory(Data_6Tribes_5y,
#' bycategory = "all", dailyagg = "avg", aggregatedonly = FALSE
#' )
-#'
+#'
TADA_FlagDepthCategory <- function(
- .data,
- bycategory = "no",
- bottomvalue = 2,
- surfacevalue = 2,
- dailyagg = "none",
- aggregatedonly = FALSE,
- clean = FALSE
+ .data,
+ bycategory = "no",
+ bottomvalue = 2,
+ surfacevalue = 2,
+ dailyagg = "none",
+ aggregatedonly = FALSE,
+ clean = FALSE
) {
# check .data is data.frame and has required columns
expected_cols <- c(
@@ -124,13 +124,17 @@ TADA_FlagDepthCategory <- function(
TADA_CheckType(.data, "data.frame", "Input object")
valid_bycategory <- c("no", "all", "surface", "middle", "bottom")
if (!bycategory %in% valid_bycategory) {
- stop("TADA_FlagDepthCategory: bycategory must be one of: 'no', 'all', 'surface', 'middle', 'bottom'.")
+ stop(
+ "TADA_FlagDepthCategory: bycategory must be one of: 'no', 'all', 'surface', 'middle', 'bottom'."
+ )
}
valid_dailyagg <- c("none", "avg", "min", "max")
if (!dailyagg %in% valid_dailyagg) {
- stop("TADA_FlagDepthCategory: dailyagg must be one of: 'none', 'avg', 'min', 'max'.")
+ stop(
+ "TADA_FlagDepthCategory: dailyagg must be one of: 'none', 'avg', 'min', 'max'."
+ )
}
-
+
# normalize 'null' and NULL inputs to NA_real_
if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
surfacevalue <- NA_real_
@@ -144,7 +148,7 @@ TADA_FlagDepthCategory <- function(
if (is.null(bottomvalue)) {
bottomvalue <- NA_real_
}
-
+
# validate types if provided
if (!is.na(surfacevalue) && !is.numeric(surfacevalue)) {
stop(
@@ -156,11 +160,11 @@ TADA_FlagDepthCategory <- function(
"TADA_FlagDepthCategory: bottomvalue must be numeric, NULL, or 'null'."
)
}
-
+
# execute function after checks are passed
-
+
depthcat.list <- c("Surface", "Bottom", "Middle")
-
+
ard.ref <- utils::read.csv(system.file(
"extdata",
"TADAActivityRelativeDepthRef.csv",
@@ -171,14 +175,14 @@ TADA_FlagDepthCategory <- function(
ActivityRelativeDepthName = Name
) |>
dplyr::select(ARD_Category, ActivityRelativeDepthName)
-
+
depth.count <- .data |>
dplyr::filter(
!is.na(TADA.ActivityDepthHeightMeasure.MeasureValue) |
!is.na(TADA.ResultDepthHeightMeasure.MeasureValue)
) |>
nrow()
-
+
# derive cattype after bycategory validation
if (bycategory == "no") {
cattype <- "for the entire depth profile"
@@ -195,7 +199,7 @@ TADA_FlagDepthCategory <- function(
if (bycategory == "surface") {
cattype <- "for Surface"
}
-
+
depth.params <- c(
"DEPTH, SECCHI DISK DEPTH",
"DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
@@ -207,7 +211,7 @@ TADA_FlagDepthCategory <- function(
"RBP STREAM DEPTH - RUN",
"THALWEG DEPTH"
)
-
+
if (depth.count > 0) {
message(paste(
"TADA_FlagDepthCategory: checking data set for depth values. ",
@@ -215,9 +219,9 @@ TADA_FlagDepthCategory <- function(
" results have depth values available.",
sep = ""
))
-
+
message("TADA_FlagDepthCategory: assigning depth categories.")
-
+
# 1) Consolidate depth and units first
.data <- .data |>
dplyr::mutate(
@@ -245,19 +249,19 @@ TADA_FlagDepthCategory <- function(
),
TADA.ConsolidatedDepth.Unit = tolower(TADA.ConsolidatedDepth.Unit)
)
-
+
# 2) Validate there is only one depth unit in use (assumes conversion already done)
units_present <- .data |>
dplyr::filter(!is.na(TADA.ConsolidatedDepth.Unit)) |>
dplyr::pull(TADA.ConsolidatedDepth.Unit) |>
unique()
-
+
if (length(units_present) > 1) {
stop(
"TADA_FlagDepthCategory: Multiple depth units detected. Convert depth units to a single unit before categorizing."
)
}
-
+
# 3) Proceed to compute bottom depth and assign categories (NA-aware)
# use group_by to identify profile data
.data <- .data |>
@@ -293,15 +297,15 @@ TADA_FlagDepthCategory <- function(
!is.na(surfacevalue) &
!is.na(TADA.ConsolidatedDepth) &
TADA.ConsolidatedDepth <= surfacevalue ~ "Surface",
-
+
# Bottom only if bottomvalue and bottom depth are available
!is.na(bottomvalue) &
!is.na(TADA.ConsolidatedDepth.Bottom) &
!is.na(TADA.ConsolidatedDepth) &
TADA.ConsolidatedDepth >=
- (TADA.ConsolidatedDepth.Bottom - bottomvalue) &
+ (TADA.ConsolidatedDepth.Bottom - bottomvalue) &
TADA.ConsolidatedDepth <= TADA.ConsolidatedDepth.Bottom ~ "Bottom",
-
+
# Middle only if both surfacevalue and bottomvalue are provided (and bottom available)
!is.na(surfacevalue) &
!is.na(bottomvalue) &
@@ -309,8 +313,8 @@ TADA_FlagDepthCategory <- function(
!is.na(TADA.ConsolidatedDepth) &
TADA.ConsolidatedDepth > surfacevalue &
TADA.ConsolidatedDepth <
- (TADA.ConsolidatedDepth.Bottom - bottomvalue) ~ "Middle",
-
+ (TADA.ConsolidatedDepth.Bottom - bottomvalue) ~ "Middle",
+
TRUE ~ NA_character_
)
) |>
@@ -338,12 +342,12 @@ TADA_FlagDepthCategory <- function(
) |>
dplyr::select(-ARD_Category, -DepthsPerGroup)
}
-
+
if (depth.count == 0) {
message(
"TADA_FlagDepthCategory: No depth information was found in the dataset. The columns TADA.DepthCategory.Flag and TADA.ConsolidatedDepth are being added and populated with NA values."
)
-
+
.data <- .data |>
dplyr::mutate(
TADA.DepthCategory.Flag = NA_character_,
@@ -352,23 +356,23 @@ TADA_FlagDepthCategory <- function(
TADA.ConsolidatedDepth.Bottom = as.numeric(NA)
) |>
TADA_OrderCols()
-
+
return(.data)
}
-
+
if (clean == TRUE) {
.data <- .data |> dplyr::filter(TADA.DepthCategory.Flag %in% depthcat.list)
}
-
+
if (clean == FALSE) {
.data <- .data
}
-
+
if (bycategory == "all") {
message(
"TADA_FlagDepthCategory: Grouping results by TADA.MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, ActivityStartDate, and TADA.DepthCategory.Flag for aggregation by TADA.DepthCategory.Flag."
)
-
+
group.list <- c(
"TADA.MonitoringLocationIdentifier",
"OrganizationIdentifier",
@@ -376,7 +380,7 @@ TADA_FlagDepthCategory <- function(
"ActivityStartDate",
"TADA.DepthCategory.Flag"
)
-
+
.data <- .data
} else {
# unify grouping branches
@@ -411,10 +415,10 @@ TADA_FlagDepthCategory <- function(
"ActivityStartDate"
)
}
-
+
if (dailyagg == "none") {
message("TADA_FlagDepthCategory: No aggregation performed.")
-
+
# add TADA.ResultValue.Aggregation.Flag, remove unecessary columns, and order columns
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -431,13 +435,13 @@ TADA_FlagDepthCategory <- function(
dplyr::select(-DepthsByGroup) |>
dplyr::ungroup() |>
TADA_OrderCols()
-
+
if (aggregatedonly == TRUE) {
stop(
"aggregatedonly = TRUE requires dailyagg = 'avg', 'min' or 'max'; nothing to return when dailyagg = 'none'."
)
}
-
+
if (aggregatedonly == FALSE) {
return(orig.data)
}
@@ -446,7 +450,7 @@ TADA_FlagDepthCategory <- function(
message(
"TADA_FlagDepthCategory: Calculating mean aggregate value with deterministically selected metadata."
)
-
+
# add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -469,7 +473,7 @@ TADA_FlagDepthCategory <- function(
TADA.DepthProfileAggregation.Flag
)
)
-
+
# add TADA.ResultValue.Aggregation.Flag, remove necessary columns, calculate mean result value per group, and assign deterministic metadata from group.
agg.data <- orig.data |>
dplyr::filter(
@@ -493,28 +497,28 @@ TADA_FlagDepthCategory <- function(
dplyr::rename(TADA.ResultMeasureValue = TADA.ResultMeasureValue1) |>
dplyr::mutate(ResultIdentifier = paste0("TADA-", ResultIdentifier)) |>
dplyr::ungroup()
-
+
if (aggregatedonly == TRUE) {
rm(orig.data)
-
+
return(agg.data)
}
-
+
if (aggregatedonly == FALSE) {
# combine original and aggregate data
comb.data <- dplyr::bind_rows(orig.data, agg.data) |>
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
-
+
rm(agg.data, orig.data)
-
+
return(comb.data)
}
}
if ((dailyagg == "min")) {
message("TADA_FlagDepthCategory: Selecting minimum aggregate value.")
-
+
# add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -537,7 +541,7 @@ TADA_FlagDepthCategory <- function(
TADA.DepthProfileAggregation.Flag
)
)
-
+
# add TADA.ResultValue.Aggregation.Flag, remove necessary columns, and select minimum result value per group.
agg.data <- orig.data |>
dplyr::filter(
@@ -557,13 +561,13 @@ TADA_FlagDepthCategory <- function(
) |>
dplyr::select(-DepthsByGroup) |>
dplyr::ungroup()
-
+
if (aggregatedonly == TRUE) {
rm(orig.data)
-
+
return(agg.data)
}
-
+
if (aggregatedonly == FALSE) {
# create list of result identifiers for selected aggregate data
agg.list <- agg.data |>
@@ -571,7 +575,7 @@ TADA_FlagDepthCategory <- function(
dplyr::select(ResultIdentifier) |>
unique() |>
dplyr::pull()
-
+
# combine original and aggregate data
comb.data <- orig.data |>
dplyr::filter(!ResultIdentifier %in% agg.list) |>
@@ -579,16 +583,16 @@ TADA_FlagDepthCategory <- function(
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
-
+
rm(agg.data, orig.data, agg.list)
-
+
return(comb.data)
}
}
-
+
if ((dailyagg == "max")) {
message("TADA_FlagDepthCategory: Selecting maximum aggregate value.")
-
+
# Flag all rows (in groups with >1 depth) as considered/not selected by default
orig.data <- .data |>
dplyr::group_by_at(group.list) |>
@@ -612,7 +616,7 @@ TADA_FlagDepthCategory <- function(
TADA.DepthProfileAggregation.Flag
)
)
-
+
# Select the maximum result per group (only rows in depth categories)
agg.data <- orig.data |>
dplyr::filter(
@@ -632,12 +636,12 @@ TADA_FlagDepthCategory <- function(
) |>
dplyr::select(-DepthsByGroup) |>
dplyr::ungroup()
-
+
if (aggregatedonly == TRUE) {
rm(orig.data)
return(agg.data)
}
-
+
if (aggregatedonly == FALSE) {
# Remove the selected rows from the original so they are not duplicated,
# then add them back with the "selected" flag applied above
@@ -646,14 +650,14 @@ TADA_FlagDepthCategory <- function(
dplyr::select(ResultIdentifier) |>
unique() |>
dplyr::pull()
-
+
comb.data <- orig.data |>
dplyr::filter(!ResultIdentifier %in% agg.list) |>
dplyr::bind_rows(agg.data) |>
dplyr::ungroup() |>
dplyr::select(-DepthsByGroup) |>
TADA_OrderCols()
-
+
rm(agg.data, orig.data, agg.list)
return(comb.data)
}
@@ -722,12 +726,12 @@ TADA_FlagDepthCategory <- function(
#'
#' # find depth profile data showing number of results
#' Data_6Tribes_5y_DepthProfileID <- TADA_IDDepthProfiles(Data_6Tribes_5y)
-#'
+#'
TADA_IDDepthProfiles <- function(
- .data,
- nresults = TRUE,
- nvalue = 2,
- aggregates = FALSE
+ .data,
+ nresults = TRUE,
+ nvalue = 2,
+ aggregates = FALSE
) {
# input type validation
TADA_CheckType(.data, "data.frame", "Input object")
@@ -736,7 +740,7 @@ TADA_IDDepthProfiles <- function(
if (!is.numeric(nvalue) || length(nvalue) != 1) {
stop("TADA_IDDepthProfiles: nvalue must be a single numeric value.")
}
-
+
# check for columns created in TADA_FlagDepthCategory and run the function if they are missing
# add check that depth category flag function has been run, run it if it has not
flag.func.cols <- c(
@@ -746,7 +750,7 @@ TADA_IDDepthProfiles <- function(
"TADA.DepthCategory.Flag",
"TADA.DepthProfileAggregation.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
message(
"TADA_IDDepthProfiles: Necessary columns from TADA_FlagDepthCategory function are included in the data frame."
@@ -758,7 +762,7 @@ TADA_IDDepthProfiles <- function(
)
.data <- TADA_FlagDepthCategory(.data)
}
-
+
depth.params <- c(
"DEPTH, SECCHI DISK DEPTH",
"DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
@@ -770,12 +774,12 @@ TADA_IDDepthProfiles <- function(
"RBP STREAM DEPTH - RUN",
"THALWEG DEPTH"
)
-
+
# when aggregates == FALSE, robust removal of mean-aggregated rows (created by avg)
if (!aggregates && "ResultIdentifier" %in% names(.data)) {
.data <- dplyr::filter(.data, !grepl("^TADA-", ResultIdentifier))
}
-
+
if (nresults == TRUE) {
.data <- .data |>
dplyr::select(
@@ -846,10 +850,10 @@ TADA_IDDepthProfiles <- function(
TADA.CharacteristicsForDepthProfile
) |>
unique()
-
+
return(.data)
}
-
+
if (identical(nresults, FALSE)) {
.data <- .data |>
dplyr::select(
@@ -912,10 +916,10 @@ TADA_IDDepthProfiles <- function(
TADA.CharacteristicsForDepthProfile
) |>
unique()
-
+
return(.data)
}
-
+
# ensure function doesn’t fall through silently
stop("TADA_IDDepthProfiles: nresults must be TRUE or FALSE.")
}
@@ -996,16 +1000,16 @@ TADA_IDDepthProfiles <- function(
#' depthcat = FALSE
#' )
#' }
-#'
+#'
TADA_DepthProfilePlot <- function(
- .data,
- groups = NULL,
- location = NULL,
- activity_date = NULL,
- depthcat = TRUE,
- surfacevalue = 2,
- bottomvalue = 2,
- unit = "m"
+ .data,
+ groups = NULL,
+ location = NULL,
+ activity_date = NULL,
+ depthcat = TRUE,
+ surfacevalue = 2,
+ bottomvalue = 2,
+ unit = "m"
) {
# check to see if TADA.ComparableDataIdentifier column is present
if (!"TADA.ComparableDataIdentifier" %in% colnames(.data)) {
@@ -1013,7 +1017,7 @@ TADA_DepthProfilePlot <- function(
"TADA.ComparableDataIdentifier column not present in data set. Run TADA_CreateComparableID to create TADA.ComparableDataIdentifier."
)
}
-
+
# check .data is data.frame
TADA_CheckType(.data, "data.frame", "Input object")
# validate unit and groups length
@@ -1021,10 +1025,12 @@ TADA_DepthProfilePlot <- function(
stop("TADA_DepthProfilePlot: unit must be 'm' or 'ft'.")
}
if (length(groups) > 3) {
- warning("TADA_DepthProfilePlot: More than 3 groups supplied; only the first 3 will be used.")
+ warning(
+ "TADA_DepthProfilePlot: More than 3 groups supplied; only the first 3 will be used."
+ )
groups <- groups[1:3]
}
-
+
# Normalize "null" to NA
if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
surfacevalue <- NA_real_
@@ -1032,7 +1038,7 @@ TADA_DepthProfilePlot <- function(
if (is.character(bottomvalue) && tolower(bottomvalue) == "null") {
bottomvalue <- NA_real_
}
-
+
# Add check that depth category flag function has been run, run it if it has not
flag.func.cols <- c(
"TADA.ConsolidatedDepth",
@@ -1040,7 +1046,7 @@ TADA_DepthProfilePlot <- function(
"TADA.ConsolidatedDepth.Bottom",
"TADA.DepthCategory.Flag"
)
-
+
if (all(flag.func.cols %in% colnames(.data))) {
message(
"TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame"
@@ -1050,7 +1056,7 @@ TADA_DepthProfilePlot <- function(
message(
"TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame"
)
-
+
if (is.na(surfacevalue) && is.na(bottomvalue)) {
.data <- TADA_FlagDepthCategory(
.data,
@@ -1092,7 +1098,7 @@ TADA_DepthProfilePlot <- function(
)
}
}
-
+
# Define depth-parameter characteristics (needed before unit checks)
depth.params <- c(
"DEPTH, SECCHI DISK DEPTH",
@@ -1105,30 +1111,41 @@ TADA_DepthProfilePlot <- function(
"RBP STREAM DEPTH - RUN",
"THALWEG DEPTH"
)
-
+
# Enforce unit consistency only across non-depth-parameter rows; depth-parameter rows will be converted later
.data <- .data |> dplyr::filter(!is.na(TADA.ConsolidatedDepth))
-
- non_depth_rows <- .data |> dplyr::filter(!TADA.CharacteristicName %in% depth.params)
+
+ non_depth_rows <- .data |>
+ dplyr::filter(!TADA.CharacteristicName %in% depth.params)
if (nrow(non_depth_rows) > 0) {
- units_present <- unique(stats::na.omit(non_depth_rows$TADA.ConsolidatedDepth.Unit))
+ units_present <- unique(stats::na.omit(
+ non_depth_rows$TADA.ConsolidatedDepth.Unit
+ ))
if (length(units_present) > 1 || units_present != unit) {
- stop("TADA_DepthProfilePlot: Convert non-depth-parameter depth units to match `unit` before plotting.")
+ stop(
+ "TADA_DepthProfilePlot: Convert non-depth-parameter depth units to match `unit` before plotting."
+ )
} else {
- message("TADA_DepthProfilePlot: Depth unit for non-depth-parameter rows matches `unit`.")
+ message(
+ "TADA_DepthProfilePlot: Depth unit for non-depth-parameter rows matches `unit`."
+ )
}
} else {
- message("TADA_DepthProfilePlot: Only depth-parameter rows detected; unit check skipped (conversion will be applied as needed).")
+ message(
+ "TADA_DepthProfilePlot: Only depth-parameter rows detected; unit check skipped (conversion will be applied as needed)."
+ )
}
-
+
# create ID Depth Profiles data.frame to check against params
param.check <- TADA_IDDepthProfiles(.data)
-
+
# Early required-argument checks
if (is.null(location) || is.null(activity_date) || is.null(groups)) {
- stop("TADA_DepthProfilePlot: Please supply 'location', 'activity_date', and 'groups'.")
+ stop(
+ "TADA_DepthProfilePlot: Please supply 'location', 'activity_date', and 'groups'."
+ )
}
-
+
# Validate they exist in the data
if (!location %in% .data$TADA.MonitoringLocationIdentifier) {
stop("TADA_DepthProfilePlot: `location` is not present in the data.")
@@ -1143,15 +1160,15 @@ TADA_DepthProfilePlot <- function(
paste(missing_groups, collapse = ", ")
))
}
-
+
# remove param.check
rm(param.check)
-
+
# Ensure optional datetime column exists for hover text
if (!"ActivityStartDateTime" %in% names(.data)) {
.data$ActivityStartDateTime <- NA_character_
}
-
+
# list required columns (include fields used in hover/name text)
required_cols <- c(
"TADA.ResultDepthHeightMeasure.MeasureValue",
@@ -1176,12 +1193,12 @@ TADA_DepthProfilePlot <- function(
"TADA.MethodSpeciationName",
"TADA.ResultSampleFractionText"
)
-
+
# check .data has required columns
TADA_CheckColumns(.data, required_cols)
-
+
message("TADA_DepthProfilePlot: Identifying available depth profile data.")
-
+
# exclude depth-parameter rows from depthprofile.avail to avoid duplication
depthprofile.avail <- .data |>
dplyr::filter(
@@ -1207,7 +1224,7 @@ TADA_DepthProfilePlot <- function(
dplyr::filter(N > 2) |>
dplyr::ungroup() |>
dplyr::select(-N)
-
+
depth.params.groups <- .data |>
dplyr::filter(
TADA.MonitoringLocationIdentifier %in% location,
@@ -1218,15 +1235,15 @@ TADA_DepthProfilePlot <- function(
dplyr::select(TADA.ComparableDataIdentifier) |>
unique() |>
dplyr::pull()
-
+
# Use user-specified depth unit for the figure
fig.depth.unit <- unit
-
+
# if any depth parameter (ex: secchi) data
if (length(intersect(groups, depth.params.groups)) > 0) {
# add depth param (ex: secchi) results
depth.params.string <- paste(depth.params, collapse = "; ")
-
+
depth.params.avail <- .data |>
dplyr::filter(
TADA.MonitoringLocationIdentifier %in% location,
@@ -1242,8 +1259,11 @@ TADA_DepthProfilePlot <- function(
) |>
dplyr::slice_sample(n = 1) |>
dplyr::ungroup()
-
- units_match <- all(stats::na.omit(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit)
+
+ units_match <- all(
+ stats::na.omit(depth.params.avail$TADA.ConsolidatedDepth.Unit) ==
+ fig.depth.unit
+ )
if (units_match) {
message(paste(
"TADA_DepthProfilePlot: Any results for",
@@ -1256,24 +1276,60 @@ TADA_DepthProfilePlot <- function(
depth.params.string,
"results to match depth units selected for the figure."
))
-
+
# consolidated conversion map for depth-parameter rows
conv_df <- data.frame(
TADA.ConsolidatedDepth.Unit = c(
- "m","ft","in","ft","in","m","in","m","ft","cm","cm","cm"
+ "m",
+ "ft",
+ "in",
+ "ft",
+ "in",
+ "m",
+ "in",
+ "m",
+ "ft",
+ "cm",
+ "cm",
+ "cm"
),
YAxis.DepthUnit = c(
- "m","m","m","ft","ft","ft","ft","in","in","m","ft","in"
+ "m",
+ "m",
+ "m",
+ "ft",
+ "ft",
+ "ft",
+ "ft",
+ "in",
+ "in",
+ "m",
+ "ft",
+ "in"
),
SecchiConversion = c(
- "1","0.3048","0.0254","3.281","0.083","39.3701","12","0.01","0.032808","0.39","0.39","0.39"
+ "1",
+ "0.3048",
+ "0.0254",
+ "3.281",
+ "0.083",
+ "39.3701",
+ "12",
+ "0.01",
+ "0.032808",
+ "0.39",
+ "0.39",
+ "0.39"
),
stringsAsFactors = FALSE
)
-
+
depth.params.avail <- depth.params.avail |>
dplyr::mutate(YAxis.DepthUnit = fig.depth.unit) |>
- dplyr::left_join(conv_df, by = c("TADA.ConsolidatedDepth.Unit", "YAxis.DepthUnit")) |>
+ dplyr::left_join(
+ conv_df,
+ by = c("TADA.ConsolidatedDepth.Unit", "YAxis.DepthUnit")
+ ) |>
dplyr::mutate(
TADA.ConsolidatedDepth.Unit = fig.depth.unit,
TADA.ConsolidatedDepth = TADA.ResultMeasureValue *
@@ -1281,14 +1337,14 @@ TADA_DepthProfilePlot <- function(
) |>
dplyr::select(-YAxis.DepthUnit, -SecchiConversion)
}
-
+
profile.data <- dplyr::bind_rows(depthprofile.avail, depth.params.avail)
rm(depth.params.avail, depthprofile.avail)
} else {
# no depth-parameter groups requested; use the main profile data only
profile.data <- depthprofile.avail
}
-
+
# this subset must include all fields included in plot hover below
plot.data <- profile.data |>
dplyr::filter(TADA.ComparableDataIdentifier %in% groups) |>
@@ -1303,14 +1359,16 @@ TADA_DepthProfilePlot <- function(
TADA.ResultMeasure.MeasureUnitCode
)
)
-
+
# Ensure there is data to plot for the selected location/date/groups
if (nrow(plot.data) == 0) {
- stop("TADA_DepthProfilePlot: No data found for the selected location, activity_date, and groups.")
+ stop(
+ "TADA_DepthProfilePlot: No data found for the selected location, activity_date, and groups."
+ )
}
-
+
rm(profile.data)
-
+
# break into subsets for each parameter
param1 <- plot.data |>
dplyr::filter(TADA.ComparableDataIdentifier %in% groups[1])
@@ -1318,7 +1376,7 @@ TADA_DepthProfilePlot <- function(
dplyr::filter(TADA.ComparableDataIdentifier %in% groups[2])
param3 <- plot.data |>
dplyr::filter(TADA.ComparableDataIdentifier %in% groups[3])
-
+
# Ensure each requested group has data for this location/date
present_groups <- plot.data |>
dplyr::count(TADA.ComparableDataIdentifier) |>
@@ -1330,9 +1388,9 @@ TADA_DepthProfilePlot <- function(
paste(missing_in_subset, collapse = ", ")
))
}
-
+
# create title for figure, conditional on number of groups/characteristics selected
-
+
# title for three characteristics
if (length(groups) == 3) {
title <- stringr::str_wrap(
@@ -1350,7 +1408,7 @@ TADA_DepthProfilePlot <- function(
width = 50
)
}
-
+
# title for two characteristics
if (length(groups) == 2) {
title <- stringr::str_wrap(
@@ -1367,7 +1425,7 @@ TADA_DepthProfilePlot <- function(
width = 50
)
}
-
+
# title for one characteristic
if (length(groups) == 1) {
title <- stringr::str_wrap(
@@ -1382,7 +1440,7 @@ TADA_DepthProfilePlot <- function(
width = 50
)
}
-
+
# figure margin
mrg <- list(
l = 50,
@@ -1391,19 +1449,19 @@ TADA_DepthProfilePlot <- function(
t = (25 + (ceiling(nchar(title) / 50)) * 25), # top margin is variable based on number of lines in title
pad = 0
)
-
+
# determine x + y max and range for plotting
xmax <- max(plot.data$TADA.ResultMeasureValue, na.rm = TRUE) +
0.5 * max(plot.data$TADA.ResultMeasureValue, na.rm = TRUE)
xrange <- c(0, xmax)
-
+
ymax <- max(plot.data$TADA.ConsolidatedDepth, na.rm = TRUE) +
0.1 * max(plot.data$TADA.ConsolidatedDepth, na.rm = TRUE)
yrange <- c(0, ymax)
-
+
# set palette
tada.pal <- TADA_ColorPalette()
-
+
# create base of scatter plot
scatterplot <- plotly::plot_ly(type = "scatter", mode = "lines+markers") |>
plotly::layout(
@@ -1445,12 +1503,12 @@ TADA_DepthProfilePlot <- function(
yanchor = "top"
)
)
-
+
# first parameter has a depth profile
if (
length(groups) >= 1 &&
- nrow(param1) > 0 &&
- !param1$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param1) > 0 &&
+ !param1$TADA.CharacteristicName[1] %in% depth.params
) {
# config options https://plotly.com/r/configuration-options/
scatterplot <- scatterplot |>
@@ -1503,12 +1561,12 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# first parameter has a single value where units are depth
if (
length(groups) >= 1 &&
- nrow(param1) > 0 &&
- param1$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param1) > 0 &&
+ param1$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1558,12 +1616,12 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# second parameter has a depth profile
if (
length(groups) >= 2 &&
- nrow(param2) > 0 &&
- !param2$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param2) > 0 &&
+ !param2$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_trace(
@@ -1614,12 +1672,12 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# second parameter has a single value where units are depth
if (
length(groups) >= 2 &&
- nrow(param2) > 0 &&
- param2$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param2) > 0 &&
+ param2$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1670,12 +1728,12 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# third parameter has a depth profile
if (
length(groups) >= 3 &&
- nrow(param3) > 0 &&
- !param3$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param3) > 0 &&
+ !param3$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_trace(
@@ -1726,12 +1784,12 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# third parameter has a single value where units are depth
if (
length(groups) >= 3 &&
- nrow(param3) > 0 &&
- param3$TADA.CharacteristicName[1] %in% depth.params
+ nrow(param3) > 0 &&
+ param3$TADA.CharacteristicName[1] %in% depth.params
) {
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1782,18 +1840,18 @@ TADA_DepthProfilePlot <- function(
)
)
}
-
+
# add horizontal lines for depth profile category
if (isTRUE(depthcat) && is.na(surfacevalue) && is.na(bottomvalue)) {
stop(
"TADA_DepthProfilePlot: No depth categories can be determined when both surfacevalue and bottomvalue are NA. Supply one or both values and run the function again."
)
}
-
+
if (isTRUE(depthcat) && (!is.na(surfacevalue) || !is.na(bottomvalue))) {
# create list to store depth annotation text
depth_annotations <- list()
-
+
# adjust margins of plot
scatterplot <- scatterplot |>
plotly::layout(
@@ -1805,10 +1863,10 @@ TADA_DepthProfilePlot <- function(
pad = 0
)
)
-
+
if (is.numeric(surfacevalue)) {
message("TADA_DepthProfilePlot: Adding surface delination to figure.")
-
+
# add surface line
scatterplot <- scatterplot |>
plotly::add_lines(
@@ -1820,7 +1878,7 @@ TADA_DepthProfilePlot <- function(
hoverinfo = "text",
hovertext = paste(surfacevalue, fig.depth.unit, sep = " ")
)
-
+
surface_text <- list(
x = 1,
y = surfacevalue / 2,
@@ -1832,13 +1890,16 @@ TADA_DepthProfilePlot <- function(
xanchor = "left",
yanchor = "center"
)
-
+
depth_annotations <- append(depth_annotations, list(surface_text))
}
-
+
if (is.numeric(bottomvalue)) {
# find bottom depth robustly; skip annotation if no finite bottom
- bd <- suppressWarnings(max(plot.data$TADA.ConsolidatedDepth.Bottom, na.rm = TRUE))
+ bd <- suppressWarnings(max(
+ plot.data$TADA.ConsolidatedDepth.Bottom,
+ na.rm = TRUE
+ ))
if (is.finite(bd)) {
message("TADA_DepthProfilePlot: Adding bottom delineation to figure.")
scatterplot <- scatterplot |>
@@ -1855,7 +1916,7 @@ TADA_DepthProfilePlot <- function(
sep = " "
)
)
-
+
bottom_text <- list(
x = 1,
y = (ymax + (bd - bottomvalue)) / 2,
@@ -1867,13 +1928,15 @@ TADA_DepthProfilePlot <- function(
xanchor = "left",
yanchor = "center"
)
-
+
depth_annotations <- append(depth_annotations, list(bottom_text))
} else {
- message("TADA_DepthProfilePlot: Bottom depth is not available; bottom delineation omitted.")
+ message(
+ "TADA_DepthProfilePlot: Bottom depth is not available; bottom delineation omitted."
+ )
}
}
-
+
if (is.numeric(surfacevalue) & is.numeric(bottomvalue) && is.finite(bd)) {
middle_text <- list(
x = 1,
@@ -1886,14 +1949,14 @@ TADA_DepthProfilePlot <- function(
xanchor = "left",
yanchor = "center"
)
-
+
depth_annotations <- append(depth_annotations, list(middle_text))
}
-
+
scatterplot <- scatterplot |>
plotly::layout(annotations = depth_annotations)
}
-
+
# return plot with no depth profile category
if (depthcat == FALSE) {
scatterplot <- scatterplot
From 8c08570f9d12c8b638401da538ef3a088bd956d8 Mon Sep 17 00:00:00 2001
From: Mullin
Date: Thu, 30 Apr 2026 18:06:55 -0400
Subject: [PATCH 22/23] refactor
---
R/DepthProfile.R | 275 +++++++++++------------
tests/testthat/test-DepthProfile.R | 336 +++++++++++++++++++++++++++++
2 files changed, 476 insertions(+), 135 deletions(-)
create mode 100644 tests/testthat/test-DepthProfile.R
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 88f4d84d6..923fac62e 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -1,3 +1,122 @@
+#' Depth-parameter characteristic names
+#'
+#' Returns the set of characteristic names that represent depth parameters
+#' (e.g., Secchi, thalweg), which are handled specially in depth consolidation
+#' and plotting.
+#'
+#' @return Character vector of characteristic names treated as depth parameters.
+#'
+#' @noRd
+.depth_param_names <- function() {
+ c(
+ "DEPTH, SECCHI DISK DEPTH",
+ "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
+ "DEPTH, SECCHI DISK DEPTH REAPPEARS",
+ "TRANSPARENCY, SECCHI TUBE WITH DISK",
+ "DEPTH, DATA-LOGGER (NON-PORTED)",
+ "DEPTH, DATA-LOGGER (PORTED)",
+ "RBP STREAM DEPTH - RIFFLE",
+ "RBP STREAM DEPTH - RUN",
+ "THALWEG DEPTH",
+ "SAMPLING DEPTH IN"
+ )
+}
+
+#' Normalize "null" or NULL numeric inputs
+#'
+#' Converts character "null" (case-insensitive) or NULL to NA_real_ for
+#' numeric options such as surfacevalue/bottomvalue. Leaves other values
+#' unchanged.
+#'
+#' @param x A value expected to be numeric, the character "null", or NULL.
+#'
+#' @return A numeric value or NA_real_.
+#'
+#' @examples
+#' # .normalize_null_numeric("null") -> NA_real_
+#' # .normalize_null_numeric(NULL) -> NA_real_
+#' # .normalize_null_numeric(2) -> 2
+#'
+#' @noRd
+.normalize_null_numeric <- function(x) {
+ if (is.character(x) && tolower(x) == "null") return(NA_real_)
+ if (is.null(x)) return(NA_real_)
+ x
+}
+
+#' Ensure depth-category columns exist
+#'
+#' Ensures the columns produced by TADA_FlagDepthCategory are present. If
+#' missing, runs TADA_FlagDepthCategory with the supplied thresholds.
+#' When allow_na_thresholds is TRUE and one or both thresholds are NA,
+#' the function runs with defaults and then blanks out categories that
+#' cannot be determined.
+#'
+#' @param .data A TADA-compatible data.frame.
+#' @param surfacevalue Numeric or NA. Threshold for Surface category (m).
+#' @param bottomvalue Numeric or NA. Threshold for Bottom category (m).
+#' @param allow_na_thresholds Logical; if TRUE, permits NA thresholds and
+#' post-adjusts depth-category flags accordingly.
+#'
+#' @return A data.frame with TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Unit,
+#' TADA.ConsolidatedDepth.Bottom, and TADA.DepthCategory.Flag present.
+#'
+#' @noRd
+.ensure_depth_flag_columns <- function(.data, surfacevalue = 2, bottomvalue = 2,
+ allow_na_thresholds = FALSE) {
+ needed <- c(
+ "TADA.ConsolidatedDepth",
+ "TADA.ConsolidatedDepth.Unit",
+ "TADA.ConsolidatedDepth.Bottom",
+ "TADA.DepthCategory.Flag"
+ )
+
+ if (all(needed %in% names(.data))) {
+ message("TADA: Necessary columns from TADA_FlagDepthCategory function are included in the data frame.")
+ return(.data)
+ }
+
+ if (allow_na_thresholds && (is.na(surfacevalue) || is.na(bottomvalue))) {
+ message("TADA: Running TADA_FlagDepthCategory to add columns; NA thresholds requested, post-adjusting flags.")
+ # run with defaults and then blank out flags that cannot be determined
+ tmp <- TADA_FlagDepthCategory(.data, surfacevalue = 2, bottomvalue = 2)
+ if (is.na(surfacevalue) && is.na(bottomvalue)) {
+ tmp$TADA.DepthCategory.Flag <- NA_character_
+ } else if (is.na(surfacevalue)) {
+ tmp$TADA.DepthCategory.Flag <- ifelse(
+ tmp$TADA.DepthCategory.Flag %in% c("Surface", "Middle"),
+ NA_character_,
+ tmp$TADA.DepthCategory.Flag
+ )
+ } else if (is.na(bottomvalue)) {
+ tmp$TADA.DepthCategory.Flag <- ifelse(
+ tmp$TADA.DepthCategory.Flag %in% c("Bottom", "Middle"),
+ NA_character_,
+ tmp$TADA.DepthCategory.Flag
+ )
+ }
+ return(tmp)
+ }
+
+ message("TADA: Running TADA_FlagDepthCategory function to add required columns to data frame.")
+ TADA_FlagDepthCategory(.data, surfacevalue = surfacevalue, bottomvalue = bottomvalue)
+}
+
+#' Drop mean-aggregated rows from data
+#'
+#' Removes rows that were created by dailyagg = "avg" in TADA_FlagDepthCategory,
+#' identified by ResultIdentifier values prefixed with "TADA-".
+#'
+#' @param .data A data.frame that may include mean-aggregated rows.
+#'
+#' @return The input data.frame with any "TADA-" ResultIdentifier rows removed.
+#'
+#' @noRd
+.drop_avg_aggregates <- function(.data) {
+ if (!"ResultIdentifier" %in% names(.data)) return(.data)
+ dplyr::filter(.data, !grepl("^TADA-", .data$ResultIdentifier))
+}
+
#' TADA_FlagDepthCategory
#'
#' This function creates a new column, TADA.DepthCategory.Flag with values: "No
@@ -136,19 +255,9 @@ TADA_FlagDepthCategory <- function(
}
# normalize 'null' and NULL inputs to NA_real_
- if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
- surfacevalue <- NA_real_
- }
- if (is.character(bottomvalue) && tolower(bottomvalue) == "null") {
- bottomvalue <- NA_real_
- }
- if (is.null(surfacevalue)) {
- surfacevalue <- NA_real_
- }
- if (is.null(bottomvalue)) {
- bottomvalue <- NA_real_
- }
-
+ surfacevalue <- .normalize_null_numeric(surfacevalue)
+ bottomvalue <- .normalize_null_numeric(bottomvalue)
+
# validate types if provided
if (!is.na(surfacevalue) && !is.numeric(surfacevalue)) {
stop(
@@ -200,18 +309,8 @@ TADA_FlagDepthCategory <- function(
cattype <- "for Surface"
}
- depth.params <- c(
- "DEPTH, SECCHI DISK DEPTH",
- "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
- "DEPTH, SECCHI DISK DEPTH REAPPEARS",
- "TRANSPARENCY, SECCHI TUBE WITH DISK",
- "DEPTH, DATA-LOGGER (NON-PORTED)",
- "DEPTH, DATA-LOGGER (PORTED)",
- "RBP STREAM DEPTH - RIFFLE",
- "RBP STREAM DEPTH - RUN",
- "THALWEG DEPTH"
- )
-
+ depth.params <- .depth_param_names()
+
if (depth.count > 0) {
message(paste(
"TADA_FlagDepthCategory: checking data set for depth values. ",
@@ -743,41 +842,13 @@ TADA_IDDepthProfiles <- function(
# check for columns created in TADA_FlagDepthCategory and run the function if they are missing
# add check that depth category flag function has been run, run it if it has not
- flag.func.cols <- c(
- "TADA.ConsolidatedDepth",
- "TADA.ConsolidatedDepth.Unit",
- "TADA.ConsolidatedDepth.Bottom",
- "TADA.DepthCategory.Flag",
- "TADA.DepthProfileAggregation.Flag"
- )
-
- if (all(flag.func.cols %in% colnames(.data)) == TRUE) {
- message(
- "TADA_IDDepthProfiles: Necessary columns from TADA_FlagDepthCategory function are included in the data frame."
- )
- .data <- .data
- } else {
- message(
- "TADA_IDDepthProfiles: Necessary columns are being added to the data frame using TADA_DepthCatgegory.Flag function."
- )
- .data <- TADA_FlagDepthCategory(.data)
- }
-
- depth.params <- c(
- "DEPTH, SECCHI DISK DEPTH",
- "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
- "DEPTH, SECCHI DISK DEPTH REAPPEARS",
- "TRANSPARENCY, SECCHI TUBE WITH DISK",
- "DEPTH, DATA-LOGGER (NON-PORTED)",
- "DEPTH, DATA-LOGGER (PORTED)",
- "RBP STREAM DEPTH - RIFFLE",
- "RBP STREAM DEPTH - RUN",
- "THALWEG DEPTH"
- )
-
+ .data <- .ensure_depth_flag_columns(.data)
+
+ depth.params <- .depth_param_names()
+
# when aggregates == FALSE, robust removal of mean-aggregated rows (created by avg)
- if (!aggregates && "ResultIdentifier" %in% names(.data)) {
- .data <- dplyr::filter(.data, !grepl("^TADA-", ResultIdentifier))
+ if (!aggregates) {
+ .data <- .drop_avg_aggregates(.data)
}
if (nresults == TRUE) {
@@ -1032,86 +1103,20 @@ TADA_DepthProfilePlot <- function(
}
# Normalize "null" to NA
- if (is.character(surfacevalue) && tolower(surfacevalue) == "null") {
- surfacevalue <- NA_real_
- }
- if (is.character(bottomvalue) && tolower(bottomvalue) == "null") {
- bottomvalue <- NA_real_
- }
-
+ surfacevalue <- .normalize_null_numeric(surfacevalue)
+ bottomvalue <- .normalize_null_numeric(bottomvalue)
+
# Add check that depth category flag function has been run, run it if it has not
- flag.func.cols <- c(
- "TADA.ConsolidatedDepth",
- "TADA.ConsolidatedDepth.Unit",
- "TADA.ConsolidatedDepth.Bottom",
- "TADA.DepthCategory.Flag"
+ .data <- .ensure_depth_flag_columns(
+ .data,
+ surfacevalue = surfacevalue,
+ bottomvalue = bottomvalue,
+ allow_na_thresholds = TRUE
)
- if (all(flag.func.cols %in% colnames(.data))) {
- message(
- "TADA_DepthProfilePlot: Necessary columns from TADA_FlagDepthCategory function are included in the data frame"
- )
- .data <- .data
- } else {
- message(
- "TADA_DepthProfilePlot: Running TADA_FlagDepthCategory function to add required columns to data frame"
- )
-
- if (is.na(surfacevalue) && is.na(bottomvalue)) {
- .data <- TADA_FlagDepthCategory(
- .data,
- surfacevalue = 2,
- bottomvalue = 2
- ) |>
- dplyr::mutate(TADA.DepthCategory.Flag = NA_character_)
- } else if (is.na(surfacevalue) && is.numeric(bottomvalue)) {
- .data <- TADA_FlagDepthCategory(
- .data,
- surfacevalue = 2,
- bottomvalue = bottomvalue
- ) |>
- dplyr::mutate(
- TADA.DepthCategory.Flag = ifelse(
- TADA.DepthCategory.Flag %in% c("Surface", "Middle"),
- NA_character_,
- TADA.DepthCategory.Flag
- )
- )
- } else if (is.na(bottomvalue) && is.numeric(surfacevalue)) {
- .data <- TADA_FlagDepthCategory(
- .data,
- surfacevalue = surfacevalue,
- bottomvalue = 2
- ) |>
- dplyr::mutate(
- TADA.DepthCategory.Flag = ifelse(
- TADA.DepthCategory.Flag %in% c("Bottom", "Middle"),
- NA_character_,
- TADA.DepthCategory.Flag
- )
- )
- } else {
- .data <- TADA_FlagDepthCategory(
- .data,
- surfacevalue = surfacevalue,
- bottomvalue = bottomvalue
- )
- }
- }
-
# Define depth-parameter characteristics (needed before unit checks)
- depth.params <- c(
- "DEPTH, SECCHI DISK DEPTH",
- "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)",
- "DEPTH, SECCHI DISK DEPTH REAPPEARS",
- "TRANSPARENCY, SECCHI TUBE WITH DISK",
- "DEPTH, DATA-LOGGER (NON-PORTED)",
- "DEPTH, DATA-LOGGER (PORTED)",
- "RBP STREAM DEPTH - RIFFLE",
- "RBP STREAM DEPTH - RUN",
- "THALWEG DEPTH"
- )
-
+ depth.params <- .depth_param_names()
+
# Enforce unit consistency only across non-depth-parameter rows; depth-parameter rows will be converted later
.data <- .data |> dplyr::filter(!is.na(TADA.ConsolidatedDepth))
diff --git a/tests/testthat/test-DepthProfile.R b/tests/testthat/test-DepthProfile.R
new file mode 100644
index 000000000..92d2c121c
--- /dev/null
+++ b/tests/testthat/test-DepthProfile.R
@@ -0,0 +1,336 @@
+# Combined testthat suite for depth helpers and functions
+
+# -------------------------
+# Internal helpers tests
+# -------------------------
+
+testthat::test_that(".depth_param_names returns expected vector", {
+ dp <- .depth_param_names()
+ testthat::expect_type(dp, "character")
+ testthat::expect_true(length(dp) >= 3)
+ testthat::expect_true(any(grepl("SECCHI", dp)))
+})
+
+testthat::test_that(".normalize_null_numeric handles inputs correctly", {
+ testthat::expect_true(is.na(.normalize_null_numeric("null")))
+ testthat::expect_true(is.na(.normalize_null_numeric(NULL)))
+ testthat::expect_identical(.normalize_null_numeric(2), 2)
+ testthat::expect_identical(.normalize_null_numeric(NA_real_), NA_real_)
+ # Non-character non-NULL values are returned as-is
+ testthat::expect_identical(.normalize_null_numeric("2"), "2")
+})
+
+testthat::test_that(".drop_avg_aggregates filters TADA- rows", {
+ df <- data.frame(
+ ResultIdentifier = c("A1", "TADA-A2", "B1", "TADA-B2"),
+ val = 1:4,
+ stringsAsFactors = FALSE
+ )
+ out <- .drop_avg_aggregates(df)
+ testthat::expect_setequal(out$ResultIdentifier, c("A1", "B1"))
+})
+
+testthat::test_that(".ensure_depth_flag_columns runs FlagDepthCategory and can blank flags for NA thresholds", {
+ # Minimal synthetic dataset (single temperature result with depth)
+ df <- tibble::tibble(
+ TADA.ActivityDepthHeightMeasure.MeasureValue = 1,
+ TADA.ResultDepthHeightMeasure.MeasureValue = NA_real_,
+ TADA.ActivityBottomDepthHeightMeasure.MeasureValue = NA_real_,
+ ActivityRelativeDepthName = NA_character_,
+ TADA.ResultDepthHeightMeasure.MeasureUnitCode = "m",
+ TADA.ActivityDepthHeightMeasure.MeasureUnitCode = "m",
+ TADA.CharacteristicName = "TEMPERATURE",
+ TADA.ResultMeasure.MeasureUnitCode = "DEG C",
+ TADA.ResultMeasureValue = 10,
+ ResultIdentifier = "R1",
+ TADA.MonitoringLocationIdentifier = "LOC1",
+ OrganizationIdentifier = "ORG1",
+ ActivityStartDate = as.Date("2020-01-01"),
+ # Extra fields used elsewhere
+ TADA.MonitoringLocationName = "Loc 1",
+ TADA.ActivityMediaName = "WATER",
+ ActivityStartDateTime = "2020-01-01T08:00:00Z",
+ ActivityMediaSubdivisionName = NA_character_,
+ TADA.ComparableDataIdentifier = "TEMPERATURE_NONE_NONE_DEG C",
+ TADA.MethodSpeciationName = "NONE",
+ TADA.ResultSampleFractionText = "NONE",
+ TADA.MonitoringLocationTypeName = "River/Stream"
+ )
+
+ out1 <- .ensure_depth_flag_columns(df, surfacevalue = 2, bottomvalue = 2, allow_na_thresholds = FALSE)
+ testthat::expect_true(all(c(
+ "TADA.ConsolidatedDepth",
+ "TADA.ConsolidatedDepth.Unit",
+ "TADA.ConsolidatedDepth.Bottom",
+ "TADA.DepthCategory.Flag"
+ ) %in% names(out1)))
+ testthat::expect_false(all(is.na(out1$TADA.DepthCategory.Flag))) # some flag assigned
+
+ out2 <- .ensure_depth_flag_columns(df, surfacevalue = NA_real_, bottomvalue = NA_real_, allow_na_thresholds = TRUE)
+ testthat::expect_true(all(is.na(out2$TADA.DepthCategory.Flag)))
+})
+
+# -------------------------
+# Fixtures
+# -------------------------
+
+make_synth_profile_only_df <- function() {
+ # Three temperature rows (profile only, no depth-parameter)
+ tibble::tibble(
+ TADA.ActivityDepthHeightMeasure.MeasureValue = c(0.5, 5, 9),
+ TADA.ResultDepthHeightMeasure.MeasureValue = c(NA_real_, NA_real_, NA_real_),
+ TADA.ActivityBottomDepthHeightMeasure.MeasureValue = c(NA_real_, NA_real_, NA_real_),
+ ActivityRelativeDepthName = NA_character_,
+ TADA.ResultDepthHeightMeasure.MeasureUnitCode = c("m", "m", "m"),
+ TADA.ActivityDepthHeightMeasure.MeasureUnitCode = c("m", "m", "m"),
+ TADA.CharacteristicName = c("TEMPERATURE", "TEMPERATURE", "TEMPERATURE"),
+ TADA.ResultMeasure.MeasureUnitCode = c("DEG C", "DEG C", "DEG C"),
+ TADA.ResultMeasureValue = c(10, 5, 1),
+ ResultIdentifier = c("T1", "T2", "T3"),
+ TADA.MonitoringLocationIdentifier = c("LOC1", "LOC1", "LOC1"),
+ OrganizationIdentifier = c("ORG1", "ORG1", "ORG1"),
+ ActivityStartDate = as.Date(rep("2020-01-01", 3)),
+ TADA.MonitoringLocationName = "Loc 1",
+ TADA.ActivityMediaName = "WATER",
+ ActivityStartDateTime = "2020-01-01T08:00:00Z",
+ ActivityMediaSubdivisionName = NA_character_,
+ TADA.ComparableDataIdentifier = rep("TEMPERATURE_NONE_NONE_DEG C", 3),
+ TADA.MethodSpeciationName = "NONE",
+ TADA.ResultSampleFractionText = "NONE",
+ TADA.MonitoringLocationTypeName = "River/Stream"
+ )
+}
+
+make_synth_depth_df_meters <- function() {
+ # Synthetic profile: 3 depths for temperature + 1 depth-param (secchi) row (in meters)
+ tibble::tibble(
+ # Use activity depth; leave result depth NA
+ TADA.ActivityDepthHeightMeasure.MeasureValue = c(0.5, 5, 9, NA),
+ TADA.ResultDepthHeightMeasure.MeasureValue = c(NA_real_, NA_real_, NA_real_, NA_real_),
+ TADA.ActivityBottomDepthHeightMeasure.MeasureValue = c(NA_real_, NA_real_, NA_real_, NA_real_),
+ ActivityRelativeDepthName = NA_character_,
+ TADA.ResultDepthHeightMeasure.MeasureUnitCode = c("m", "m", "m", "m"), # not used (result depth NA)
+ TADA.ActivityDepthHeightMeasure.MeasureUnitCode = c("m", "m", "m", "m"),
+ TADA.CharacteristicName = c("TEMPERATURE", "TEMPERATURE", "TEMPERATURE", "DEPTH, SECCHI DISK DEPTH"),
+ TADA.ResultMeasure.MeasureUnitCode = c("DEG C", "DEG C", "DEG C", "m"),
+ TADA.ResultMeasureValue = c(10, 5, 1, 1.2), # secchi in meters
+ ResultIdentifier = c("T1", "T2", "T3", "S1"),
+ TADA.MonitoringLocationIdentifier = c("LOC1", "LOC1", "LOC1", "LOC1"),
+ OrganizationIdentifier = c("ORG1", "ORG1", "ORG1", "ORG1"),
+ ActivityStartDate = as.Date(rep("2020-01-01", 4)),
+ # fields used elsewhere
+ TADA.MonitoringLocationName = "Loc 1",
+ TADA.ActivityMediaName = "WATER",
+ ActivityStartDateTime = "2020-01-01T08:00:00Z",
+ ActivityMediaSubdivisionName = NA_character_,
+ TADA.ComparableDataIdentifier = c(
+ "TEMPERATURE_NONE_NONE_DEG C",
+ "TEMPERATURE_NONE_NONE_DEG C",
+ "TEMPERATURE_NONE_NONE_DEG C",
+ "DEPTH, SECCHI DISK DEPTH_NONE_NONE_M"
+ ),
+ TADA.MethodSpeciationName = "NONE",
+ TADA.ResultSampleFractionText = "NONE",
+ TADA.MonitoringLocationTypeName = "River/Stream"
+ )
+}
+
+make_synth_depth_df_mixed_units_annotated <- function() {
+ # Start with meters-only, annotate with FlagDepthCategory, then mutate the Secchi row to have ft unit
+ df_m <- make_synth_depth_df_meters()
+ df_ann <- TADA_FlagDepthCategory(df_m, dailyagg = "none")
+ is_depth_param <- df_ann$TADA.CharacteristicName %in% .depth_param_names()
+ # Convert the depth-parameter row "appearance" to feet for plotting conversion path
+ df_ann$TADA.ResultMeasureValue[is_depth_param] <- 4
+ df_ann$TADA.ResultMeasure.MeasureUnitCode[is_depth_param] <- "ft"
+ df_ann$TADA.ConsolidatedDepth.Unit[is_depth_param] <- "ft" # force mismatch with figure unit ("m")
+ df_ann$TADA.ConsolidatedDepth[is_depth_param] <- 4 # arbitrary ft value; plot will convert using ResultMeasureValue
+ df_ann$TADA.ComparableDataIdentifier[is_depth_param] <- "DEPTH, SECCHI DISK DEPTH_NONE_NONE_M"
+ df_ann
+}
+
+# -------------------------
+# TADA_FlagDepthCategory tests
+# -------------------------
+
+testthat::test_that("TADA_FlagDepthCategory assigns Surface/Middle/Bottom with bycategory = 'no'", {
+ df <- make_synth_depth_df_meters()
+ out <- TADA_FlagDepthCategory(df, bycategory = "no", surfacevalue = 2, bottomvalue = 2, dailyagg = "none")
+ # Filter to temperature rows
+ temp <- out[out$TADA.CharacteristicName == "TEMPERATURE", ]
+ flags <- temp$TADA.DepthCategory.Flag
+ testthat::expect_true(all(c("Surface","Middle","Bottom") %in% flags))
+})
+
+testthat::test_that("TADA_FlagDepthCategory filters categories with bycategory filters", {
+ df <- make_synth_depth_df_meters()
+ out_surface <- TADA_FlagDepthCategory(df, bycategory = "surface", dailyagg = "none")
+ testthat::expect_true(all(out_surface$TADA.DepthCategory.Flag == "Surface"))
+ out_bottom <- TADA_FlagDepthCategory(df, bycategory = "bottom", dailyagg = "none")
+ testthat::expect_true(all(out_bottom$TADA.DepthCategory.Flag == "Bottom"))
+})
+
+testthat::test_that("TADA_FlagDepthCategory dailyagg = 'none' with aggregatedonly = TRUE errors", {
+ df <- make_synth_depth_df_meters()
+ testthat::expect_error(TADA_FlagDepthCategory(df, dailyagg = "none", aggregatedonly = TRUE))
+})
+
+testthat::test_that("TADA_FlagDepthCategory dailyagg = 'avg' returns aggregate with prefix when aggregatedonly = TRUE", {
+ df <- make_synth_depth_df_meters()
+ out <- TADA_FlagDepthCategory(df, bycategory = "no", dailyagg = "avg", aggregatedonly = TRUE)
+ testthat::expect_true(all(grepl("^TADA-", out$ResultIdentifier)))
+ testthat::expect_equal(nrow(out), 1L) # single group aggregate (entire water column)
+})
+
+testthat::test_that("TADA_FlagDepthCategory dailyagg = 'min' and 'max' select one row each", {
+ df <- make_synth_depth_df_meters()
+ out_min <- TADA_FlagDepthCategory(df, bycategory = "no", dailyagg = "min", aggregatedonly = TRUE)
+ out_max <- TADA_FlagDepthCategory(df, bycategory = "no", dailyagg = "max", aggregatedonly = TRUE)
+ testthat::expect_equal(nrow(out_min), 1L)
+ testthat::expect_equal(nrow(out_max), 1L)
+ # min should pick the lowest temperature value (1 at bottom depth)
+ testthat::expect_equal(out_min$TADA.ResultMeasureValue, 1)
+ # max should pick the highest temperature value (10 at surface)
+ testthat::expect_equal(out_max$TADA.ResultMeasureValue, 10)
+})
+
+testthat::test_that("TADA_FlagDepthCategory clean = TRUE keeps only depth categories", {
+ df <- make_synth_depth_df_meters()
+ out <- TADA_FlagDepthCategory(df, clean = TRUE)
+ testthat::expect_true(all(out$TADA.DepthCategory.Flag %in% c("Surface","Middle","Bottom")))
+})
+
+testthat::test_that("TADA_FlagDepthCategory stops on multiple depth units", {
+ df <- make_synth_depth_df_meters()
+ # Inject a second unit in the temperature rows by populating result depth with different unit
+ df$TADA.ResultDepthHeightMeasure.MeasureValue <- df$TADA.ActivityDepthHeightMeasure.MeasureValue
+ df$TADA.ResultDepthHeightMeasure.MeasureUnitCode <- c("m","m","ft","ft")
+ testthat::expect_error(TADA_FlagDepthCategory(df))
+})
+
+testthat::test_that("TADA_FlagDepthCategory handles data with no depth info", {
+ df <- make_synth_depth_df_meters()
+ # Wipe out all depth fields so depth.count == 0
+ df$TADA.ActivityDepthHeightMeasure.MeasureValue <- NA_real_
+ df$TADA.ResultDepthHeightMeasure.MeasureValue <- NA_real_
+ out <- TADA_FlagDepthCategory(df)
+ testthat::expect_true(all(is.na(out$TADA.ConsolidatedDepth)))
+ testthat::expect_true(all(is.na(out$TADA.ConsolidatedDepth.Bottom)))
+ testthat::expect_true(all(is.na(out$TADA.DepthCategory.Flag)))
+})
+
+# -------------------------
+# TADA_IDDepthProfiles tests
+# -------------------------
+
+testthat::test_that("TADA_IDDepthProfiles lists characteristics with counts (default)", {
+ df <- make_synth_depth_df_meters()
+ out <- TADA_IDDepthProfiles(df, nresults = TRUE, nvalue = 2, aggregates = FALSE)
+ testthat::expect_true(all(c(
+ "TADA.MonitoringLocationIdentifier",
+ "TADA.MonitoringLocationName",
+ "OrganizationIdentifier",
+ "ActivityStartDate",
+ "TADA.CharacteristicsForDepthProfile"
+ ) %in% names(out)))
+ # Should include temperature comparable ID with count "(3)"
+ testthat::expect_true(any(grepl("TEMPERATURE_NONE_NONE_DEG C \\(3\\)", out$TADA.CharacteristicsForDepthProfile)))
+})
+
+testthat::test_that("TADA_IDDepthProfiles without counts and higher threshold", {
+ df <- make_synth_depth_df_meters()
+ # With nvalue = 3, temperature group qualifies (3 depths)
+ out <- TADA_IDDepthProfiles(df, nresults = FALSE, nvalue = 3, aggregates = FALSE)
+ testthat::expect_true(any(grepl("TEMPERATURE_NONE_NONE_DEG C", out$TADA.CharacteristicsForDepthProfile)))
+ # With nvalue = 4, temperature is dropped; depth-parameter remains only if a profile is present
+ out2 <- TADA_IDDepthProfiles(df, nresults = FALSE, nvalue = 4, aggregates = FALSE)
+ # Because the function also requires MeanResults > 1 across the group,
+ # and only secchi has 1 depth, the whole group will be filtered out.
+ testthat::expect_equal(nrow(out2), 0)
+})
+
+testthat::test_that("TADA_IDDepthProfiles respects aggregates = FALSE by ignoring TADA- average rows", {
+ df <- make_synth_depth_df_meters()
+
+ # First, annotate the base data with consolidated depth/category columns
+ df_annot <- TADA_FlagDepthCategory(df, dailyagg = "none")
+
+ # Baseline: no TADA- rows present
+ base_out <- TADA_IDDepthProfiles(df_annot, nresults = TRUE, aggregates = FALSE)
+
+ # Create an averaged aggregate row from the annotated data and append
+ avg_only <- TADA_FlagDepthCategory(df_annot, bycategory = "no", dailyagg = "avg", aggregatedonly = TRUE)
+ df2 <- dplyr::bind_rows(df_annot, avg_only)
+
+ # Now run IDDepthProfiles with aggregates = FALSE; TADA- row should be ignored
+ out <- TADA_IDDepthProfiles(df2, nresults = TRUE, aggregates = FALSE)
+
+ # Normalize for comparison:
+ normalize_df <- function(x) {
+ x |>
+ dplyr::ungroup() |>
+ dplyr::mutate(
+ TADA.CharacteristicsForDepthProfile = stringr::str_squish(TADA.CharacteristicsForDepthProfile)
+ ) |>
+ dplyr::arrange(
+ TADA.MonitoringLocationIdentifier,
+ OrganizationIdentifier,
+ ActivityStartDate,
+ TADA.CharacteristicsForDepthProfile
+ )
+ }
+
+ out_norm <- normalize_df(out)
+ base_norm <- normalize_df(base_out)
+
+ testthat::expect_equal(nrow(out_norm), nrow(base_norm))
+ testthat::expect_equal(names(out_norm), names(base_norm))
+ testthat::expect_equal(out_norm, base_norm, ignore_attr = TRUE)
+})
+
+testthat::test_that("TADA_DepthProfilePlot checks non-depth-parameter units against `unit`", {
+ testthat::skip_if_not_installed("plotly")
+ # Profile-only data in meters; asking for ft should error
+ df <- make_synth_profile_only_df()
+ testthat::expect_error(TADA_DepthProfilePlot(
+ df,
+ groups = c("TEMPERATURE_NONE_NONE_DEG C"),
+ location = "LOC1",
+ activity_date = as.Date("2020-01-01"),
+ depthcat = FALSE,
+ unit = "ft"
+ ))
+})
+
+testthat::test_that("TADA_DepthProfilePlot argument validation for missing inputs", {
+ testthat::skip_if_not_installed("plotly")
+ df <- make_synth_profile_only_df()
+ testthat::expect_error(TADA_DepthProfilePlot(df)) # missing location/date/groups
+ testthat::expect_error(TADA_DepthProfilePlot(
+ df,
+ groups = c("TEMPERATURE_NONE_NONE_DEG C"),
+ location = "NOT_IN_DATA",
+ activity_date = as.Date("2020-01-01")
+ ))
+ testthat::expect_error(TADA_DepthProfilePlot(
+ df,
+ groups = c("NOT_A_GROUP"),
+ location = "LOC1",
+ activity_date = as.Date("2020-01-01")
+ ))
+})
+
+testthat::test_that("TADA_DepthProfilePlot depthcat requires at least one threshold when TRUE", {
+ testthat::skip_if_not_installed("plotly")
+ df <- make_synth_profile_only_df()
+ testthat::expect_error(TADA_DepthProfilePlot(
+ df,
+ groups = c("TEMPERATURE_NONE_NONE_DEG C"),
+ location = "LOC1",
+ activity_date = as.Date("2020-01-01"),
+ depthcat = TRUE,
+ surfacevalue = NA_real_,
+ bottomvalue = NA_real_,
+ unit = "m"
+ ))
+})
From 6737da59fbfec9e8fe655039361eaf0e76cba869 Mon Sep 17 00:00:00 2001
From: "pre-commit-ci[bot]"
<66853113+pre-commit-ci[bot]@users.noreply.github.com>
Date: Thu, 30 Apr 2026 22:07:37 +0000
Subject: [PATCH 23/23] [pre-commit.ci] auto fixes from pre-commit.com hooks
for more information, see https://pre-commit.ci
---
R/DepthProfile.R | 60 ++++++---
tests/testthat/test-DepthProfile.R | 208 ++++++++++++++++++++++-------
2 files changed, 198 insertions(+), 70 deletions(-)
diff --git a/R/DepthProfile.R b/R/DepthProfile.R
index 923fac62e..e278609e7 100644
--- a/R/DepthProfile.R
+++ b/R/DepthProfile.R
@@ -39,8 +39,12 @@
#'
#' @noRd
.normalize_null_numeric <- function(x) {
- if (is.character(x) && tolower(x) == "null") return(NA_real_)
- if (is.null(x)) return(NA_real_)
+ if (is.character(x) && tolower(x) == "null") {
+ return(NA_real_)
+ }
+ if (is.null(x)) {
+ return(NA_real_)
+ }
x
}
@@ -62,22 +66,30 @@
#' TADA.ConsolidatedDepth.Bottom, and TADA.DepthCategory.Flag present.
#'
#' @noRd
-.ensure_depth_flag_columns <- function(.data, surfacevalue = 2, bottomvalue = 2,
- allow_na_thresholds = FALSE) {
+.ensure_depth_flag_columns <- function(
+ .data,
+ surfacevalue = 2,
+ bottomvalue = 2,
+ allow_na_thresholds = FALSE
+) {
needed <- c(
"TADA.ConsolidatedDepth",
"TADA.ConsolidatedDepth.Unit",
"TADA.ConsolidatedDepth.Bottom",
"TADA.DepthCategory.Flag"
)
-
+
if (all(needed %in% names(.data))) {
- message("TADA: Necessary columns from TADA_FlagDepthCategory function are included in the data frame.")
+ message(
+ "TADA: Necessary columns from TADA_FlagDepthCategory function are included in the data frame."
+ )
return(.data)
}
-
+
if (allow_na_thresholds && (is.na(surfacevalue) || is.na(bottomvalue))) {
- message("TADA: Running TADA_FlagDepthCategory to add columns; NA thresholds requested, post-adjusting flags.")
+ message(
+ "TADA: Running TADA_FlagDepthCategory to add columns; NA thresholds requested, post-adjusting flags."
+ )
# run with defaults and then blank out flags that cannot be determined
tmp <- TADA_FlagDepthCategory(.data, surfacevalue = 2, bottomvalue = 2)
if (is.na(surfacevalue) && is.na(bottomvalue)) {
@@ -97,9 +109,15 @@
}
return(tmp)
}
-
- message("TADA: Running TADA_FlagDepthCategory function to add required columns to data frame.")
- TADA_FlagDepthCategory(.data, surfacevalue = surfacevalue, bottomvalue = bottomvalue)
+
+ message(
+ "TADA: Running TADA_FlagDepthCategory function to add required columns to data frame."
+ )
+ TADA_FlagDepthCategory(
+ .data,
+ surfacevalue = surfacevalue,
+ bottomvalue = bottomvalue
+ )
}
#' Drop mean-aggregated rows from data
@@ -113,7 +131,9 @@
#'
#' @noRd
.drop_avg_aggregates <- function(.data) {
- if (!"ResultIdentifier" %in% names(.data)) return(.data)
+ if (!"ResultIdentifier" %in% names(.data)) {
+ return(.data)
+ }
dplyr::filter(.data, !grepl("^TADA-", .data$ResultIdentifier))
}
@@ -256,8 +276,8 @@ TADA_FlagDepthCategory <- function(
# normalize 'null' and NULL inputs to NA_real_
surfacevalue <- .normalize_null_numeric(surfacevalue)
- bottomvalue <- .normalize_null_numeric(bottomvalue)
-
+ bottomvalue <- .normalize_null_numeric(bottomvalue)
+
# validate types if provided
if (!is.na(surfacevalue) && !is.numeric(surfacevalue)) {
stop(
@@ -310,7 +330,7 @@ TADA_FlagDepthCategory <- function(
}
depth.params <- .depth_param_names()
-
+
if (depth.count > 0) {
message(paste(
"TADA_FlagDepthCategory: checking data set for depth values. ",
@@ -843,9 +863,9 @@ TADA_IDDepthProfiles <- function(
# check for columns created in TADA_FlagDepthCategory and run the function if they are missing
# add check that depth category flag function has been run, run it if it has not
.data <- .ensure_depth_flag_columns(.data)
-
+
depth.params <- .depth_param_names()
-
+
# when aggregates == FALSE, robust removal of mean-aggregated rows (created by avg)
if (!aggregates) {
.data <- .drop_avg_aggregates(.data)
@@ -1104,8 +1124,8 @@ TADA_DepthProfilePlot <- function(
# Normalize "null" to NA
surfacevalue <- .normalize_null_numeric(surfacevalue)
- bottomvalue <- .normalize_null_numeric(bottomvalue)
-
+ bottomvalue <- .normalize_null_numeric(bottomvalue)
+
# Add check that depth category flag function has been run, run it if it has not
.data <- .ensure_depth_flag_columns(
.data,
@@ -1116,7 +1136,7 @@ TADA_DepthProfilePlot <- function(
# Define depth-parameter characteristics (needed before unit checks)
depth.params <- .depth_param_names()
-
+
# Enforce unit consistency only across non-depth-parameter rows; depth-parameter rows will be converted later
.data <- .data |> dplyr::filter(!is.na(TADA.ConsolidatedDepth))
diff --git a/tests/testthat/test-DepthProfile.R b/tests/testthat/test-DepthProfile.R
index 92d2c121c..38db9cf03 100644
--- a/tests/testthat/test-DepthProfile.R
+++ b/tests/testthat/test-DepthProfile.R
@@ -56,17 +56,30 @@ testthat::test_that(".ensure_depth_flag_columns runs FlagDepthCategory and can b
TADA.ResultSampleFractionText = "NONE",
TADA.MonitoringLocationTypeName = "River/Stream"
)
-
- out1 <- .ensure_depth_flag_columns(df, surfacevalue = 2, bottomvalue = 2, allow_na_thresholds = FALSE)
- testthat::expect_true(all(c(
- "TADA.ConsolidatedDepth",
- "TADA.ConsolidatedDepth.Unit",
- "TADA.ConsolidatedDepth.Bottom",
- "TADA.DepthCategory.Flag"
- ) %in% names(out1)))
+
+ out1 <- .ensure_depth_flag_columns(
+ df,
+ surfacevalue = 2,
+ bottomvalue = 2,
+ allow_na_thresholds = FALSE
+ )
+ testthat::expect_true(all(
+ c(
+ "TADA.ConsolidatedDepth",
+ "TADA.ConsolidatedDepth.Unit",
+ "TADA.ConsolidatedDepth.Bottom",
+ "TADA.DepthCategory.Flag"
+ ) %in%
+ names(out1)
+ ))
testthat::expect_false(all(is.na(out1$TADA.DepthCategory.Flag))) # some flag assigned
-
- out2 <- .ensure_depth_flag_columns(df, surfacevalue = NA_real_, bottomvalue = NA_real_, allow_na_thresholds = TRUE)
+
+ out2 <- .ensure_depth_flag_columns(
+ df,
+ surfacevalue = NA_real_,
+ bottomvalue = NA_real_,
+ allow_na_thresholds = TRUE
+ )
testthat::expect_true(all(is.na(out2$TADA.DepthCategory.Flag)))
})
@@ -78,8 +91,16 @@ make_synth_profile_only_df <- function() {
# Three temperature rows (profile only, no depth-parameter)
tibble::tibble(
TADA.ActivityDepthHeightMeasure.MeasureValue = c(0.5, 5, 9),
- TADA.ResultDepthHeightMeasure.MeasureValue = c(NA_real_, NA_real_, NA_real_),
- TADA.ActivityBottomDepthHeightMeasure.MeasureValue = c(NA_real_, NA_real_, NA_real_),
+ TADA.ResultDepthHeightMeasure.MeasureValue = c(
+ NA_real_,
+ NA_real_,
+ NA_real_
+ ),
+ TADA.ActivityBottomDepthHeightMeasure.MeasureValue = c(
+ NA_real_,
+ NA_real_,
+ NA_real_
+ ),
ActivityRelativeDepthName = NA_character_,
TADA.ResultDepthHeightMeasure.MeasureUnitCode = c("m", "m", "m"),
TADA.ActivityDepthHeightMeasure.MeasureUnitCode = c("m", "m", "m"),
@@ -106,12 +127,27 @@ make_synth_depth_df_meters <- function() {
tibble::tibble(
# Use activity depth; leave result depth NA
TADA.ActivityDepthHeightMeasure.MeasureValue = c(0.5, 5, 9, NA),
- TADA.ResultDepthHeightMeasure.MeasureValue = c(NA_real_, NA_real_, NA_real_, NA_real_),
- TADA.ActivityBottomDepthHeightMeasure.MeasureValue = c(NA_real_, NA_real_, NA_real_, NA_real_),
+ TADA.ResultDepthHeightMeasure.MeasureValue = c(
+ NA_real_,
+ NA_real_,
+ NA_real_,
+ NA_real_
+ ),
+ TADA.ActivityBottomDepthHeightMeasure.MeasureValue = c(
+ NA_real_,
+ NA_real_,
+ NA_real_,
+ NA_real_
+ ),
ActivityRelativeDepthName = NA_character_,
TADA.ResultDepthHeightMeasure.MeasureUnitCode = c("m", "m", "m", "m"), # not used (result depth NA)
TADA.ActivityDepthHeightMeasure.MeasureUnitCode = c("m", "m", "m", "m"),
- TADA.CharacteristicName = c("TEMPERATURE", "TEMPERATURE", "TEMPERATURE", "DEPTH, SECCHI DISK DEPTH"),
+ TADA.CharacteristicName = c(
+ "TEMPERATURE",
+ "TEMPERATURE",
+ "TEMPERATURE",
+ "DEPTH, SECCHI DISK DEPTH"
+ ),
TADA.ResultMeasure.MeasureUnitCode = c("DEG C", "DEG C", "DEG C", "m"),
TADA.ResultMeasureValue = c(10, 5, 1, 1.2), # secchi in meters
ResultIdentifier = c("T1", "T2", "T3", "S1"),
@@ -143,9 +179,11 @@ make_synth_depth_df_mixed_units_annotated <- function() {
# Convert the depth-parameter row "appearance" to feet for plotting conversion path
df_ann$TADA.ResultMeasureValue[is_depth_param] <- 4
df_ann$TADA.ResultMeasure.MeasureUnitCode[is_depth_param] <- "ft"
- df_ann$TADA.ConsolidatedDepth.Unit[is_depth_param] <- "ft" # force mismatch with figure unit ("m")
- df_ann$TADA.ConsolidatedDepth[is_depth_param] <- 4 # arbitrary ft value; plot will convert using ResultMeasureValue
- df_ann$TADA.ComparableDataIdentifier[is_depth_param] <- "DEPTH, SECCHI DISK DEPTH_NONE_NONE_M"
+ df_ann$TADA.ConsolidatedDepth.Unit[is_depth_param] <- "ft" # force mismatch with figure unit ("m")
+ df_ann$TADA.ConsolidatedDepth[is_depth_param] <- 4 # arbitrary ft value; plot will convert using ResultMeasureValue
+ df_ann$TADA.ComparableDataIdentifier[
+ is_depth_param
+ ] <- "DEPTH, SECCHI DISK DEPTH_NONE_NONE_M"
df_ann
}
@@ -155,37 +193,70 @@ make_synth_depth_df_mixed_units_annotated <- function() {
testthat::test_that("TADA_FlagDepthCategory assigns Surface/Middle/Bottom with bycategory = 'no'", {
df <- make_synth_depth_df_meters()
- out <- TADA_FlagDepthCategory(df, bycategory = "no", surfacevalue = 2, bottomvalue = 2, dailyagg = "none")
+ out <- TADA_FlagDepthCategory(
+ df,
+ bycategory = "no",
+ surfacevalue = 2,
+ bottomvalue = 2,
+ dailyagg = "none"
+ )
# Filter to temperature rows
temp <- out[out$TADA.CharacteristicName == "TEMPERATURE", ]
flags <- temp$TADA.DepthCategory.Flag
- testthat::expect_true(all(c("Surface","Middle","Bottom") %in% flags))
+ testthat::expect_true(all(c("Surface", "Middle", "Bottom") %in% flags))
})
testthat::test_that("TADA_FlagDepthCategory filters categories with bycategory filters", {
df <- make_synth_depth_df_meters()
- out_surface <- TADA_FlagDepthCategory(df, bycategory = "surface", dailyagg = "none")
+ out_surface <- TADA_FlagDepthCategory(
+ df,
+ bycategory = "surface",
+ dailyagg = "none"
+ )
testthat::expect_true(all(out_surface$TADA.DepthCategory.Flag == "Surface"))
- out_bottom <- TADA_FlagDepthCategory(df, bycategory = "bottom", dailyagg = "none")
+ out_bottom <- TADA_FlagDepthCategory(
+ df,
+ bycategory = "bottom",
+ dailyagg = "none"
+ )
testthat::expect_true(all(out_bottom$TADA.DepthCategory.Flag == "Bottom"))
})
testthat::test_that("TADA_FlagDepthCategory dailyagg = 'none' with aggregatedonly = TRUE errors", {
df <- make_synth_depth_df_meters()
- testthat::expect_error(TADA_FlagDepthCategory(df, dailyagg = "none", aggregatedonly = TRUE))
+ testthat::expect_error(TADA_FlagDepthCategory(
+ df,
+ dailyagg = "none",
+ aggregatedonly = TRUE
+ ))
})
testthat::test_that("TADA_FlagDepthCategory dailyagg = 'avg' returns aggregate with prefix when aggregatedonly = TRUE", {
df <- make_synth_depth_df_meters()
- out <- TADA_FlagDepthCategory(df, bycategory = "no", dailyagg = "avg", aggregatedonly = TRUE)
+ out <- TADA_FlagDepthCategory(
+ df,
+ bycategory = "no",
+ dailyagg = "avg",
+ aggregatedonly = TRUE
+ )
testthat::expect_true(all(grepl("^TADA-", out$ResultIdentifier)))
testthat::expect_equal(nrow(out), 1L) # single group aggregate (entire water column)
})
testthat::test_that("TADA_FlagDepthCategory dailyagg = 'min' and 'max' select one row each", {
df <- make_synth_depth_df_meters()
- out_min <- TADA_FlagDepthCategory(df, bycategory = "no", dailyagg = "min", aggregatedonly = TRUE)
- out_max <- TADA_FlagDepthCategory(df, bycategory = "no", dailyagg = "max", aggregatedonly = TRUE)
+ out_min <- TADA_FlagDepthCategory(
+ df,
+ bycategory = "no",
+ dailyagg = "min",
+ aggregatedonly = TRUE
+ )
+ out_max <- TADA_FlagDepthCategory(
+ df,
+ bycategory = "no",
+ dailyagg = "max",
+ aggregatedonly = TRUE
+ )
testthat::expect_equal(nrow(out_min), 1L)
testthat::expect_equal(nrow(out_max), 1L)
# min should pick the lowest temperature value (1 at bottom depth)
@@ -197,14 +268,16 @@ testthat::test_that("TADA_FlagDepthCategory dailyagg = 'min' and 'max' select on
testthat::test_that("TADA_FlagDepthCategory clean = TRUE keeps only depth categories", {
df <- make_synth_depth_df_meters()
out <- TADA_FlagDepthCategory(df, clean = TRUE)
- testthat::expect_true(all(out$TADA.DepthCategory.Flag %in% c("Surface","Middle","Bottom")))
+ testthat::expect_true(all(
+ out$TADA.DepthCategory.Flag %in% c("Surface", "Middle", "Bottom")
+ ))
})
testthat::test_that("TADA_FlagDepthCategory stops on multiple depth units", {
df <- make_synth_depth_df_meters()
# Inject a second unit in the temperature rows by populating result depth with different unit
df$TADA.ResultDepthHeightMeasure.MeasureValue <- df$TADA.ActivityDepthHeightMeasure.MeasureValue
- df$TADA.ResultDepthHeightMeasure.MeasureUnitCode <- c("m","m","ft","ft")
+ df$TADA.ResultDepthHeightMeasure.MeasureUnitCode <- c("m", "m", "ft", "ft")
testthat::expect_error(TADA_FlagDepthCategory(df))
})
@@ -225,25 +298,49 @@ testthat::test_that("TADA_FlagDepthCategory handles data with no depth info", {
testthat::test_that("TADA_IDDepthProfiles lists characteristics with counts (default)", {
df <- make_synth_depth_df_meters()
- out <- TADA_IDDepthProfiles(df, nresults = TRUE, nvalue = 2, aggregates = FALSE)
- testthat::expect_true(all(c(
- "TADA.MonitoringLocationIdentifier",
- "TADA.MonitoringLocationName",
- "OrganizationIdentifier",
- "ActivityStartDate",
- "TADA.CharacteristicsForDepthProfile"
- ) %in% names(out)))
+ out <- TADA_IDDepthProfiles(
+ df,
+ nresults = TRUE,
+ nvalue = 2,
+ aggregates = FALSE
+ )
+ testthat::expect_true(all(
+ c(
+ "TADA.MonitoringLocationIdentifier",
+ "TADA.MonitoringLocationName",
+ "OrganizationIdentifier",
+ "ActivityStartDate",
+ "TADA.CharacteristicsForDepthProfile"
+ ) %in%
+ names(out)
+ ))
# Should include temperature comparable ID with count "(3)"
- testthat::expect_true(any(grepl("TEMPERATURE_NONE_NONE_DEG C \\(3\\)", out$TADA.CharacteristicsForDepthProfile)))
+ testthat::expect_true(any(grepl(
+ "TEMPERATURE_NONE_NONE_DEG C \\(3\\)",
+ out$TADA.CharacteristicsForDepthProfile
+ )))
})
testthat::test_that("TADA_IDDepthProfiles without counts and higher threshold", {
df <- make_synth_depth_df_meters()
# With nvalue = 3, temperature group qualifies (3 depths)
- out <- TADA_IDDepthProfiles(df, nresults = FALSE, nvalue = 3, aggregates = FALSE)
- testthat::expect_true(any(grepl("TEMPERATURE_NONE_NONE_DEG C", out$TADA.CharacteristicsForDepthProfile)))
+ out <- TADA_IDDepthProfiles(
+ df,
+ nresults = FALSE,
+ nvalue = 3,
+ aggregates = FALSE
+ )
+ testthat::expect_true(any(grepl(
+ "TEMPERATURE_NONE_NONE_DEG C",
+ out$TADA.CharacteristicsForDepthProfile
+ )))
# With nvalue = 4, temperature is dropped; depth-parameter remains only if a profile is present
- out2 <- TADA_IDDepthProfiles(df, nresults = FALSE, nvalue = 4, aggregates = FALSE)
+ out2 <- TADA_IDDepthProfiles(
+ df,
+ nresults = FALSE,
+ nvalue = 4,
+ aggregates = FALSE
+ )
# Because the function also requires MeanResults > 1 across the group,
# and only secchi has 1 depth, the whole group will be filtered out.
testthat::expect_equal(nrow(out2), 0)
@@ -251,26 +348,37 @@ testthat::test_that("TADA_IDDepthProfiles without counts and higher threshold",
testthat::test_that("TADA_IDDepthProfiles respects aggregates = FALSE by ignoring TADA- average rows", {
df <- make_synth_depth_df_meters()
-
+
# First, annotate the base data with consolidated depth/category columns
df_annot <- TADA_FlagDepthCategory(df, dailyagg = "none")
-
+
# Baseline: no TADA- rows present
- base_out <- TADA_IDDepthProfiles(df_annot, nresults = TRUE, aggregates = FALSE)
-
+ base_out <- TADA_IDDepthProfiles(
+ df_annot,
+ nresults = TRUE,
+ aggregates = FALSE
+ )
+
# Create an averaged aggregate row from the annotated data and append
- avg_only <- TADA_FlagDepthCategory(df_annot, bycategory = "no", dailyagg = "avg", aggregatedonly = TRUE)
+ avg_only <- TADA_FlagDepthCategory(
+ df_annot,
+ bycategory = "no",
+ dailyagg = "avg",
+ aggregatedonly = TRUE
+ )
df2 <- dplyr::bind_rows(df_annot, avg_only)
-
+
# Now run IDDepthProfiles with aggregates = FALSE; TADA- row should be ignored
out <- TADA_IDDepthProfiles(df2, nresults = TRUE, aggregates = FALSE)
-
+
# Normalize for comparison:
normalize_df <- function(x) {
x |>
dplyr::ungroup() |>
dplyr::mutate(
- TADA.CharacteristicsForDepthProfile = stringr::str_squish(TADA.CharacteristicsForDepthProfile)
+ TADA.CharacteristicsForDepthProfile = stringr::str_squish(
+ TADA.CharacteristicsForDepthProfile
+ )
) |>
dplyr::arrange(
TADA.MonitoringLocationIdentifier,
@@ -279,10 +387,10 @@ testthat::test_that("TADA_IDDepthProfiles respects aggregates = FALSE by ignorin
TADA.CharacteristicsForDepthProfile
)
}
-
+
out_norm <- normalize_df(out)
base_norm <- normalize_df(base_out)
-
+
testthat::expect_equal(nrow(out_norm), nrow(base_norm))
testthat::expect_equal(names(out_norm), names(base_norm))
testthat::expect_equal(out_norm, base_norm, ignore_attr = TRUE)