From 0d1b9521b3385533eefe0ab80e5f75f74c6978a7 Mon Sep 17 00:00:00 2001 From: Kevin See Date: Wed, 27 Mar 2024 13:21:25 -0700 Subject: [PATCH 1/5] added some additional code to flag sites with 3 nodes, since addParentChildNodes currently can't handle that situation well. --- R/addParentChildNodes.R | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/R/addParentChildNodes.R b/R/addParentChildNodes.R index f924611..1c987ca 100644 --- a/R/addParentChildNodes.R +++ b/R/addParentChildNodes.R @@ -68,10 +68,16 @@ addParentChildNodes = function(parent_child = NULL, if("node_3" %in% names(node_wide)) { - node_wide %>% + site_3_nodes <- + node_wide %>% filter(!is.na(node_3)) %>% - pull(site_code) %>% - paste(paste(., collapse = " and "), "have 3 nodes, causing errors.\n Consider updating configuration file.\n") + pull(site_code) + + site_message = if_else(length(site_3_nodes) == 1, + site_3_nodes, + paste(site_3_nodes, collapse = " and ")) + + message(paste(site_message, "have 3 nodes, causing errors.\n Consider updating configuration file.\n")) } pc_nodes = parent_child %>% @@ -85,7 +91,7 @@ addParentChildNodes = function(parent_child = NULL, tidyr::nest(node_info = -any_of(names(parent_child))) %>% ungroup() %>% mutate(pc = map(node_info, - .f = function(x) { + .f = try(function(x) { if(x$n_parent_nodes == 1) { pc_new = x %>% select(parent = node_1.x, @@ -97,6 +103,8 @@ addParentChildNodes = function(parent_child = NULL, bind_rows(x %>% select(parent = node_2.x, child = node_1.y)) + } else { + pc_new = NULL } if(x$n_child_nodes == 2) { @@ -107,7 +115,7 @@ addParentChildNodes = function(parent_child = NULL, } return(pc_new) - })) %>% + }))) %>% select(-parent, -child) %>% tidyr::unnest(cols = pc) %>% select(parent, From d5385fcea0a293cbb4edf4ff422470095a9582dd Mon Sep 17 00:00:00 2001 From: Kevin See Date: Wed, 27 Mar 2024 13:21:54 -0700 Subject: [PATCH 2/5] tiny update to the code to prep data from LEMTRP. Doesn't change output. --- inst/test_scripts/prep_pkg_data.R | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/inst/test_scripts/prep_pkg_data.R b/inst/test_scripts/prep_pkg_data.R index ce8e931..b4154b0 100644 --- a/inst/test_scripts/prep_pkg_data.R +++ b/inst/test_scripts/prep_pkg_data.R @@ -699,17 +699,13 @@ root_site = "LEMTRP" configuration <- buildConfig(node_assign = "site") |> mutate(across(node, - ~ if_else(as.numeric(str_sub(rkm, 1, 3)) <= 234, - "B2J", - .)), - across(node, - ~ if_else(site_code == "GRS", - "GRJ", - .))) |> + ~ case_when(as.numeric(str_sub(rkm, 1, 3)) <= 234 ~ "B2J", + site_code %in% c("GRJ", "GRS") ~ "GRJ", + .default = .))) |> filter(!is.na(node)) # read in PTAGIS detections -ptagis_file = here('inst/extdata/LEMTRP', +ptagis_file = here('inst/extdata', "LEMTRP_chnk_cth_2021.csv") From 8c432d402d587e3a02e8c3c5e0542ee8ff12429e Mon Sep 17 00:00:00 2001 From: Kevin See Date: Fri, 16 Aug 2024 15:47:34 -0700 Subject: [PATCH 3/5] lowered the required version of readxl, to make it compatible with test of IBM platform --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2d2e32a..9fd22ad 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,7 @@ Imports: nhdplusTools (>= 1.0.0), nngeo (>= 0.4.6), here (>= 1.0.1), - readxl (>= 1.4.2), + readxl (>= 1.4.0), tidygraph (>= 1.2.3), XML (>= 3.99.0.9), xml2 (>= 1.3.3), From 00eb21c5e98249c05d90c85a1f0b96a3f9108ac2 Mon Sep 17 00:00:00 2001 From: Kevin See Date: Mon, 7 Oct 2024 11:58:32 -0700 Subject: [PATCH 4/5] fixed a minor issue caused by a mismatch of "ignore_event_vs_release" parameter between this function and compress --- R/prepWrapper.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/prepWrapper.R b/R/prepWrapper.R index 808a0f0..657cd29 100644 --- a/R/prepWrapper.R +++ b/R/prepWrapper.R @@ -60,6 +60,7 @@ prepWrapper = function(compress_obs = NULL, compress_obs = compress(raw_obs, configuration = configuration, + ignore_event_vs_release = ignore_event_vs_release, ...) } From a5a2e1f9bc2ba333d884ef6c08d66c913607ea1c Mon Sep 17 00:00:00 2001 From: Kevin See Date: Tue, 22 Oct 2024 11:29:45 -0700 Subject: [PATCH 5/5] added an option in the addParentChildNodes function to accomodate different array suffixes in the configuration file --- DESCRIPTION | 2 +- R/addParentChildNodes.R | 47 +++++++++++++++++++++++++++----------- man/addParentChildNodes.Rd | 11 ++++++++- 3 files changed, 45 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9fd22ad..b18d5af 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,7 @@ URL: https://github.com/KevinSee/PITcleanr, BugReports: https://github.com/KevinSee/PITcleanr/issues Encoding: UTF-8 LazyData: true -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Suggests: ggrepel, kableExtra, diff --git a/R/addParentChildNodes.R b/R/addParentChildNodes.R index 1c987ca..dadb9d5 100644 --- a/R/addParentChildNodes.R +++ b/R/addParentChildNodes.R @@ -8,6 +8,7 @@ #' #' @param parent_child dataframe produced by `buildParentChild()`. #' @param configuration a configuration dataframe, such as one built by `buildConfig()`. +#' @inheritParams buildConfig #' #' @import dplyr tidyr stringr #' @return NULL @@ -15,24 +16,44 @@ #' @examples addParentChildNodes() addParentChildNodes = function(parent_child = NULL, - configuration = NULL) { + configuration = NULL, + array_suffix = c("UD", + "UMD", + "A0B0")) { stopifnot(!is.null(parent_child), !is.null(configuration)) + array_suffix = match.arg(array_suffix) + # get the nodes for all site codes in the parent-child table - node_long = tibble(site_code = union(parent_child$child, + if(array_suffix %in% c("UD", "UMD")) { + node_site <- + configuration %>% + select(node) %>% + distinct() %>% + mutate(site_code = case_when(stringr::str_detect(node, "_D$") & + nchar(node) >= 5 ~ stringr::str_remove(node, "_D$"), + stringr::str_detect(node, "_U$") & + nchar(node) >= 5 ~ stringr::str_remove(node, "_U$"), + stringr::str_detect(node, "_M$") & + nchar(node) >= 5 ~ stringr::str_remove(node, "_M$"), + .default = node)) + } else { + node_site <- + configuration %>% + select(node) %>% + distinct() %>% + mutate(site_code = case_when(stringr::str_detect(node, "B0$") & + nchar(node) >= 5 ~ stringr::str_remove(node, "B0$"), + stringr::str_detect(node, "A0$") & + nchar(node) >= 5 ~ stringr::str_remove(node, "A0$"), + .default = node)) + } + + node_long <- + tibble(site_code = union(parent_child$child, parent_child$parent)) %>% - left_join(configuration %>% - select(node) %>% - distinct() %>% - mutate(site_code = if_else(stringr::str_detect(node, "_D$") & - nchar(node) >= 5, - stringr::str_remove(node, "_D$"), - node), - site_code = if_else(stringr::str_detect(site_code, "_U$") & - nchar(site_code) >= 5, - stringr::str_remove(site_code, "_U$"), - site_code)), + left_join(node_site, by = "site_code") %>% distinct() %>% arrange(site_code, node) %>% diff --git a/man/addParentChildNodes.Rd b/man/addParentChildNodes.Rd index 2f36f8e..b01a735 100644 --- a/man/addParentChildNodes.Rd +++ b/man/addParentChildNodes.Rd @@ -4,12 +4,21 @@ \alias{addParentChildNodes} \title{Add Nodes to Parent-Child Table} \usage{ -addParentChildNodes(parent_child = NULL, configuration = NULL) +addParentChildNodes( + parent_child = NULL, + configuration = NULL, + array_suffix = c("UD", "UMD", "A0B0") +) } \arguments{ \item{parent_child}{dataframe produced by `buildParentChild()`.} \item{configuration}{a configuration dataframe, such as one built by `buildConfig()`.} + +\item{array_suffix}{if \code{node_assign = "array"}, should nodes uses the suffixes of _U & _D (\code{UD}), +_U, _M, & _D (\code{UMD}), or _A0 & _B0 (\code{A0B0}) to denote upstream, middle, and downstream arrays, respectively. +Default is \code{UD}. If \code{array_suffix = "UD"} or \code{array_suffix = "A0B0"}, the middle array is grouped +with the upstream array.} } \description{ When some sites in the parent-child table have multiple nodes, this function