Merge pull request #61 from KevinSee/develop

minor updates
KevinSee · Oct 22, 2024 · 4ca44b8 · 4ca44b8
2 parents 3930ae7 + a5a2e1f
commit 4ca44b8
Show file tree

Hide file tree

Showing 5 changed files with 64 additions and 29 deletions.
diff --git 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
@@ -8,31 +8,52 @@
 #'
 #' @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
 #' @export
 #' @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
@@ -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
@@ -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
-Original file line number
+Diff line change
@@ Expand Up / @@ -60,6 +60,7 @@ prepWrapper = function(compress_obs = NULL, @@
         compress_obs = compress(raw_obs,
                                 configuration = configuration,
+                                ignore_event_vs_release = ignore_event_vs_release,
                                 ...)
       }
@@ Expand Down @@