diff --git a/hyfabric/DESCRIPTION b/hyfabric/DESCRIPTION index 8b270047c218225ce27bb7357a2f145ec29fb8b9..163459449abc143c8a6a84f14da0251e9921fcf1 100644 --- a/hyfabric/DESCRIPTION +++ b/hyfabric/DESCRIPTION @@ -1,7 +1,7 @@ Package: hyfabric Type: Package Title: Utility functions for creating the reference geospatial fabric. -Version: 0.5.0 +Version: 0.5.1 Authors@R: c(person(given = "David", family = "Blodgett", role = c("aut", "cre"), diff --git a/hyfabric/NAMESPACE b/hyfabric/NAMESPACE index 8fb8c0302356b7695eaa72a28d149a79c0febff3..15344f1d146811364956c526749dcb647726eaff 100644 --- a/hyfabric/NAMESPACE +++ b/hyfabric/NAMESPACE @@ -1,7 +1,16 @@ # Generated by roxygen2: do not edit by hand export(NetworkConnection) +export(POI_creation) export(get_rpu_dependent_vars) export(needs_layer) +export(switchDiv) import(dplyr) +importFrom(dplyr,filter) +importFrom(dplyr,inner_join) +importFrom(dplyr,left_join) +importFrom(dplyr,mutate) +importFrom(dplyr,select) +importFrom(nhdplusTools,get_node) +importFrom(sf,st_drop_geometry) importFrom(sf,st_layers) diff --git a/hyfabric/R/poi_creation.R b/hyfabric/R/poi_creation.R new file mode 100644 index 0000000000000000000000000000000000000000..4d820f0ee0f610ab0b662b3f62cb6823528449e4 --- /dev/null +++ b/hyfabric/R/poi_creation.R @@ -0,0 +1,34 @@ +#' Creates POIs for a given data theme +#' @param srcData (data.frame) (data frame) DF with two columns: +# 1 - COMID +# 2 - Unique ID value for POI (Streamgage ID, etc.) +#' @param nhdDF (sf data.frame) valid data frame of NHD flowlines +#' @param IDfield character) Name of 'Type' field to be modified in POI +#' +#' @return (sf data.frame) OIs for the specific data theme +#' @importFrom nhdplusTools get_node +#' @importFrom dplyr filter mutate inner_join select +#' @export +POI_creation<-function(srcData, nhdDF, IDfield){ + + # Give generic ID to Identity field + colnames(srcData) <- c("COMID", "ID") + + sub_segs <- filter(nhdDF, COMID %in% srcData$COMID) + + POIs <- sub_segs %>% + get_node(., position = "end") %>% + mutate(COMID = sub_segs$COMID) %>% + mutate(Type_HUC12 = NA, Type_WBIn = NA, Type_WBOut = NA, Type_Gages = NA, Type_TE = NA, Type_NID = NA, Type_Conf = NA) %>% + inner_join(srcData %>% select(COMID, ID), by = "COMID") %>% + mutate(!!(paste0("Type_", IDfield)) := ID) + + if(!(paste0("Type_", IDfield)) %in% colnames(POIs)){ + POIs <- POIs %>% select(COMID, Type_HUC12, Type_Gages, Type_TE, Type_NID, Type_WBIn, Type_WBOut, Type_Conf) + } else { + POIs <- POIs %>% select(COMID, Type_HUC12, Type_Gages, Type_TE, + Type_NID, Type_WBIn, Type_WBOut, Type_Conf, !!(paste0("Type_", IDfield))) + } + + return(POIs) +} diff --git a/hyfabric/R/switchdiv.R b/hyfabric/R/switchdiv.R new file mode 100644 index 0000000000000000000000000000000000000000..aab1fa6f9e4149097e5258f839fda7c9d3737d80 --- /dev/null +++ b/hyfabric/R/switchdiv.R @@ -0,0 +1,38 @@ +#' Switches valid POIs from minor to major path divergences +#' @param inSegs (list) list of input COMIDs representing POIs +#' @param nhdDF (sf data.frame) (data frame) valid data frame of NHD flowlines +#' +#' @return (sf data.frame) Corresponding major path COMID for POI +#' @importFrom dplyr filter inner_join select left_join mutate +#' @importFrom sf st_drop_geometry +#' @export +switchDiv <- function(insegs, nhdDF){ + + div_segs <- filter(nhdDF, COMID %in% insegs$COMID) + if (2 %in% div_segs$Divergence){ + print ("Switching divergence to other fork") + + # Look Upstream + upstream <- st_drop_geometry(nhdDF) %>% + inner_join(st_drop_geometry(div_segs) %>% + filter(Divergence == 2) %>% + select(COMID, Hydroseq), + by = c("DnMinorHyd" = "Hydroseq")) + + # From Upstream Segment switch POI to the downstream major/main path + insegs_maj <- st_drop_geometry(nhdDF) %>% + inner_join(upstream %>% select(COMID.y, DnHydroseq), + by = c("Hydroseq" = "DnHydroseq")) %>% + select(COMID, COMID.y) + + insegs <- insegs %>% + left_join(insegs_maj, by = c("COMID" = "COMID.y")) %>% + mutate(COMID = ifelse(!is.na(COMID.y), COMID.y, COMID)) %>% + select(-COMID.y) + + } else { + message("no divergences present in POI set") + } + + return(insegs) +} diff --git a/hyfabric/man/POI_creation.Rd b/hyfabric/man/POI_creation.Rd new file mode 100644 index 0000000000000000000000000000000000000000..29ce518cda96923c830a05400fff57627b1f199d --- /dev/null +++ b/hyfabric/man/POI_creation.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/poi_creation.R +\name{POI_creation} +\alias{POI_creation} +\title{Creates POIs for a given data theme} +\usage{ +POI_creation(srcData, nhdDF, IDfield) +} +\arguments{ +\item{srcData}{(data.frame) (data frame) DF with two columns:} + +\item{nhdDF}{(sf data.frame) valid data frame of NHD flowlines} + +\item{IDfield}{character) Name of 'Type' field to be modified in POI} +} +\value{ +(sf data.frame) OIs for the specific data theme +} +\description{ +Creates POIs for a given data theme +} diff --git a/hyfabric/man/switchDiv.Rd b/hyfabric/man/switchDiv.Rd new file mode 100644 index 0000000000000000000000000000000000000000..aa6de01b8d6bc73610ea107efd4b3097c17096aa --- /dev/null +++ b/hyfabric/man/switchDiv.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/switchdiv.R +\name{switchDiv} +\alias{switchDiv} +\title{Switches valid POIs from minor to major path divergences} +\usage{ +switchDiv(insegs, nhdDF) +} +\arguments{ +\item{nhdDF}{(sf data.frame) (data frame) valid data frame of NHD flowlines} + +\item{inSegs}{(list) list of input COMIDs representing POIs} +} +\value{ +(sf data.frame) Corresponding major path COMID for POI +} +\description{ +Switches valid POIs from minor to major path divergences +} diff --git a/hyfabric/tests/testthat/test_poi_creation.R b/hyfabric/tests/testthat/test_poi_creation.R new file mode 100644 index 0000000000000000000000000000000000000000..18e5b2aff295eab183d38062fd520999bb0caf7c --- /dev/null +++ b/hyfabric/tests/testthat/test_poi_creation.R @@ -0,0 +1,12 @@ +test_that("poi_creation", { + in_data <- readRDS(list.files(pattern = "poi_creation.rds", + full.names = TRUE, + recursive = TRUE)) + + poi <- data.frame(COMID = in_data$COMID[1], ID = "12345") + + poi_out <- POI_creation(poi, in_data, "HUC12") + + expect_equal(poi_out$Type_HUC12, "12345") + expect_equal(poi_out$COMID, in_data$COMID[1]) +}) diff --git a/hyfabric/tests/testthat/test_switchdiv.R b/hyfabric/tests/testthat/test_switchdiv.R new file mode 100644 index 0000000000000000000000000000000000000000..232d4e4692682238ac353ed478c4e4379ca4eb7b --- /dev/null +++ b/hyfabric/tests/testthat/test_switchdiv.R @@ -0,0 +1,8 @@ +test_that("switchdiv", { + source(system.file("extdata/new_hope_data.R", package = "nhdplusTools")) + + suppressMessages(expect_equal( + switchDiv(data.frame(COMID = 8893200), new_hope_flowline), + data.frame(COMID = 8893188))) + +}) diff --git a/workspace/R/NHD_navigate.R b/workspace/R/NHD_navigate.R index 0d277cb57ebaac89fe176832e6f4e86801680fdf..28b9272968e275be6f609095b38559bd4a88ccc3 100644 --- a/workspace/R/NHD_navigate.R +++ b/workspace/R/NHD_navigate.R @@ -55,73 +55,74 @@ NetworkNav <- function(inCom, nhdDF, withTrib){ #' return(incom) #' } - -#' Switches valid POIs from minor to major path divergences -#' @param inSegs (list) list of input COMIDs representing POIs -#' @param nhdDF (sf data.frame) (data frame) valid data frame of NHD flowlines +## Deprecated -- see hyfabric package +#' #' Switches valid POIs from minor to major path divergences +#' #' @param inSegs (list) list of input COMIDs representing POIs +#' #' @param nhdDF (sf data.frame) (data frame) valid data frame of NHD flowlines +#' #' +#' #' @return (sf data.frame) Corresponding major path COMID for POI +#' switchDiv <- function(insegs, nhdDF){ #' -#' @return (sf data.frame) Corresponding major path COMID for POI -switchDiv <- function(insegs, nhdDF){ - - div_segs <- filter(nhdDF, COMID %in% insegs$COMID) - if (2 %in% div_segs$Divergence){ - print ("Switching divergence to other fork") - - # Look Upstream - upstream <- st_drop_geometry(nhdDF) %>% - inner_join(st_drop_geometry(div_segs) %>% - filter(Divergence == 2) %>% - select(COMID, Hydroseq), - by = c("DnMinorHyd" = "Hydroseq")) - - # From Upstream Segment switch POI to the downstream major/main path - insegs_maj <- st_drop_geometry(nhdDF) %>% - inner_join(upstream %>% select(COMID.y, DnHydroseq), - by = c("Hydroseq" = "DnHydroseq")) %>% - select(COMID, COMID.y) - - insegs <- insegs %>% - left_join(insegs_maj, by = c("COMID" = "COMID.y")) %>% - mutate(COMID = ifelse(!is.na(COMID.y), COMID.y, COMID)) %>% select(-COMID.y) - - } else { - print ("no divergences present in POI set") - } - return(insegs) -} - - -#' Creates POIs for a given data theme -#' @param srcData (data.frame) (data frame) DF with two columns: -# 1 - COMID -# 2 - Unique ID value for POI (Streamgage ID, etc.) -#' @param nhdDF (sf data.frame) valid data frame of NHD flowlines -#' @param IDfield character) Name of 'Type' field to be modified in POI +#' div_segs <- filter(nhdDF, COMID %in% insegs$COMID) +#' if (2 %in% div_segs$Divergence){ +#' print ("Switching divergence to other fork") +#' +#' # Look Upstream +#' upstream <- st_drop_geometry(nhdDF) %>% +#' inner_join(st_drop_geometry(div_segs) %>% +#' filter(Divergence == 2) %>% +#' select(COMID, Hydroseq), +#' by = c("DnMinorHyd" = "Hydroseq")) +#' +#' # From Upstream Segment switch POI to the downstream major/main path +#' insegs_maj <- st_drop_geometry(nhdDF) %>% +#' inner_join(upstream %>% select(COMID.y, DnHydroseq), +#' by = c("Hydroseq" = "DnHydroseq")) %>% +#' select(COMID, COMID.y) +#' +#' insegs <- insegs %>% +#' left_join(insegs_maj, by = c("COMID" = "COMID.y")) %>% +#' mutate(COMID = ifelse(!is.na(COMID.y), COMID.y, COMID)) %>% select(-COMID.y) #' -#' @return (sf data.frame) OIs for the specific data theme -POI_creation<-function(srcData, nhdDF, IDfield){ - - # Give generic ID to Identity field - colnames(srcData) <- c("COMID", "ID") - - sub_segs <- filter(nhdDF, COMID %in% srcData$COMID) +#' } else { +#' print ("no divergences present in POI set") +#' } +#' return(insegs) +#' } - POIs <- sub_segs %>% - get_node(., position = "end") %>% - mutate(COMID = sub_segs$COMID) %>% - mutate(Type_HUC12 = NA, Type_WBIn = NA, Type_WBOut = NA, Type_Gages = NA, Type_TE = NA, Type_NID = NA, Type_Conf = NA) %>% - inner_join(srcData %>% select(COMID, ID), by = "COMID") %>% - mutate(!!(paste0("Type_", IDfield)) := ID) - - if(!(paste0("Type_", IDfield)) %in% colnames(POIs)){ - POIs <- POIs %>% select(COMID, Type_HUC12, Type_Gages, Type_TE, Type_NID, Type_WBIn, Type_WBOut, Type_Conf) - } else { - POIs <- POIs %>% select(COMID, Type_HUC12, Type_Gages, Type_TE, - Type_NID, Type_WBIn, Type_WBOut, Type_Conf, !!(paste0("Type_", IDfield))) - } - return(POIs) -} +## Deprecated -- see hyfabric package +#' #' Creates POIs for a given data theme +#' #' @param srcData (data.frame) (data frame) DF with two columns: +#' # 1 - COMID +#' # 2 - Unique ID value for POI (Streamgage ID, etc.) +#' #' @param nhdDF (sf data.frame) valid data frame of NHD flowlines +#' #' @param IDfield character) Name of 'Type' field to be modified in POI +#' #' +#' #' @return (sf data.frame) OIs for the specific data theme +#' POI_creation<-function(srcData, nhdDF, IDfield){ +#' +#' # Give generic ID to Identity field +#' colnames(srcData) <- c("COMID", "ID") +#' +#' sub_segs <- filter(nhdDF, COMID %in% srcData$COMID) +#' +#' POIs <- sub_segs %>% +#' get_node(., position = "end") %>% +#' mutate(COMID = sub_segs$COMID) %>% +#' mutate(Type_HUC12 = NA, Type_WBIn = NA, Type_WBOut = NA, Type_Gages = NA, Type_TE = NA, Type_NID = NA, Type_Conf = NA) %>% +#' inner_join(srcData %>% select(COMID, ID), by = "COMID") %>% +#' mutate(!!(paste0("Type_", IDfield)) := ID) +#' +#' if(!(paste0("Type_", IDfield)) %in% colnames(POIs)){ +#' POIs <- POIs %>% select(COMID, Type_HUC12, Type_Gages, Type_TE, Type_NID, Type_WBIn, Type_WBOut, Type_Conf) +#' } else { +#' POIs <- POIs %>% select(COMID, Type_HUC12, Type_Gages, Type_TE, +#' Type_NID, Type_WBIn, Type_WBOut, Type_Conf, !!(paste0("Type_", IDfield))) +#' } +#' +#' return(POIs) +#' } #' Adds the type attribute for co-located POIs of multiple themes #' @param new_POIs (sf data.frame) new POIs to be tested against existing diff --git a/workspace/hyfabric_0.5.1.tar.gz b/workspace/hyfabric_0.5.1.tar.gz new file mode 100644 index 0000000000000000000000000000000000000000..38b2f308131324ec8a92d3742351920f095e4c2e Binary files /dev/null and b/workspace/hyfabric_0.5.1.tar.gz differ