diff --git a/DESCRIPTION b/DESCRIPTION index 2d2e32a..b18d5af 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), @@ -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 f924611..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) %>% @@ -68,10 +89,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 +112,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 +124,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 +136,7 @@ addParentChildNodes = function(parent_child = NULL, } return(pc_new) - })) %>% + }))) %>% select(-parent, -child) %>% tidyr::unnest(cols = pc) %>% select(parent, 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, ...) } 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") 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