diff --git a/workspace/02_NHD_navigate.Rmd b/workspace/02_NHD_navigate.Rmd
index cf67a7101d8d191173c0b493fba8371161a0cdb0..2ada86a85f91ff92a1085bd736d8822a70990e2a 100644
--- a/workspace/02_NHD_navigate.Rmd
+++ b/workspace/02_NHD_navigate.Rmd
@@ -306,8 +306,7 @@ if(all(is.na(tmp_POIs$Type_WBOut))) {
# Create waterbody inlet POIs
wbin_COMIDs <- filter(nhd, WB == 0,
- DnHydroseq %in% filter(nhd, WB == 1)$Hydroseq,
- TotDASqKM >= min_da_km) %>%
+ DnHydroseq %in% filter(nhd, WB == 1)$Hydroseq) %>%
select(-WBAREACOMI) %>%
switchDiv(., nhd) %>%
inner_join(st_drop_geometry(filter(nhd, minNet == 1)) %>%
@@ -316,7 +315,7 @@ if(all(is.na(tmp_POIs$Type_WBOut))) {
group_by(COMID) %>%
filter(row_number() == 1) %>%
ungroup()
-
+
tmp_POIs <- POI_creation(filter(st_drop_geometry(wbout_COMIDs), !COMID %in% wbin_COMIDs$COMID),
filter(nhd, poi == 1), "WBOut") %>%
addType(., tmp_POIs, "WBOut")
@@ -412,19 +411,29 @@ if(!all(is.na(tmp_POIs$Type_Elev)))
```{r Time of travel POIs}
if(all(is.na(tmp_POIs$Type_Travel))) {
-
- tt_pois_init <- inc_segs %>%
+
+ # derive incremental segments from POIs
+ inc_segs <- segment_increment(filter(nhd, minNet == 1),
+ filter(st_drop_geometry(nhd),
+ COMID %in% tmp_POIs$COMID, COMID %in% filter(nhd, minNet == 1)$COMID)) %>%
+ # bring over VAA data
+ inner_join(select(atts, COMID, DnHydroseq, VA_MA, TOTMA, LENGTHKM, MAXELEVSMO, MINELEVSMO, WBAREACOMI, WBAreaType, FTYPE,
+ AreaSqKM, TotDASqKM), by = "COMID")
+
+ # TT POIs
+ tt_pois_split <- inc_segs %>%
# Should we substitute with a very small value
mutate(VA_MA = ifelse(VA_MA < 0, NA, VA_MA)) %>%
mutate(FL_tt_hrs = (LENGTHKM * 3280.84)/ VA_MA / 3600 ) %>%
group_by(POI_ID) %>%
- filter(sum(FL_tt_hrs) > tt_diff, TotDASqKM > max_elev_TT_DA) %>%
+ filter(sum(FL_tt_hrs) > travt_diff, TotDASqKM > max_elev_TT_DA) %>%
# Sort upstream to downsream
arrange(desc(Hydroseq)) %>%
# Get cumulative sums of median elevation
mutate(csum_length = cumsum(LENGTHKM),
cumsum_tt = cumsum(FL_tt_hrs),
- iter = min(round(sum(FL_tt_hrs) / tt_diff), n())) %>%
+ iter = min(round(sum(FL_tt_hrs) / travt_diff), n()),
+ tt_POI_ID = NA) %>%
# Only look to split segments based on travel time longer than 10 km
#filter(sum(LENGTHKM) > (split_meters/1000)) %>%
filter(iter > 0, n() > 1) %>%
@@ -432,50 +441,28 @@ if(all(is.na(tmp_POIs$Type_Travel))) {
mutate(orig_iter = iter) %>%
ungroup()
-
- # For reach iteration
- elev_POIs <- do.call("rbind", lapply(unique(elev_pois_split$POI_ID), split_elev,
- elev_pois_split, elev_diff*100, max_elev_TT_DA)) %>%
- filter(!elev_POI_ID %in% tmp_POIs$COMID, COMID == elev_POI_ID) %>%
- mutate(Type_Elev = 1) %>%
- select(COMID, Type_Elev) %>%
- unique()
-
- # For reach iteration, generate new P OIs
- new_POIs <- tt_pois_init %>%
- group_by(POI_ID) %>%
- # select for new POIs that meet criteria, put some size criteria within
- filter(split_tt < cumsum_tt, TotDASqKM > 1, csum_length > ((split_meters/1000) / 2)) %>%
- # for each poi get the most upstream fl that matches
- filter(Hydroseq == max(Hydroseq)) %>%
- mutate(Type_Travel = 1) %>%
- ungroup()
-
- # Create new POI data frame
- if(exists("tt_POIs")){
- tt_POIs <- rbind(tt_POIs, new_POIs)
- } else {
- tt_POIs <- new_POIs
- }
-
- # create new set for next iteration
- tt_pois_init <- tt_pois_init_post %>%
- filter(POI_ID %in% new_POIs$POI_ID & iter != i)
-
- # IF further case exist, re-calc the cum. elev change
- if(nrow(tt_pois_init) > 0){
- tt_pois_init <- tt_pois_init %>%
- group_by(POI_ID) %>%
- mutate(cumsum_tt = cumsum(FL_tt_hrs)) %>%
- filter(max(cumsum_tt) > tt_diff) %>%
- ungroup()
- }
-
- }
+ # For reach iteration
+ tt_POIs <- do.call("rbind", lapply(unique(tt_pois_split$POI_ID), split_tt,
+ tt_pois_split, travt_diff, max_elev_TT_DA)) %>%
+ filter(!tt_POI_ID %in% tmp_POIs$COMID, COMID == tt_POI_ID) %>%
+ mutate(Type_Travel = 1) %>%
+ select(COMID, Type_Travel) %>%
+ unique()
+ # For reach iteration, generate new P OIs
+ new_POIs <- tt_pois_split %>%
+ group_by(POI_ID) %>%
+ # select for new POIs that meet criteria, put some size criteria within
+ filter(split_tt < cumsum_tt, TotDASqKM > 1, csum_length > ((split_meters/1000) / 2)) %>%
+ # for each poi get the most upstream fl that matches
+ filter(Hydroseq == max(Hydroseq)) %>%
+ mutate(Type_Travel = 1) %>%
+ ungroup()
+
tmp_POIs <- POI_creation(select(tt_POIs, COMID, Type_Travel), nhd, "Travel") %>%
+ mutate(Type_Term = NA) %>%
addType(., tmp_POIs, "Travel")
-
+
write_sf(tmp_POIs, nav_gpkg, nav_poi_layer)
}else{
tmp_POIs <- read_sf(nav_gpkg, nav_poi_layer)
@@ -566,23 +553,23 @@ print (paste0(nrow(sub[sub$AreaSqKM == 0,]), " POIs on flowlines with no local d
if(needs_layer(nav_gpkg, final_poi_layer)) {
#1 Move POIs downstream by category
- out_gages <- POI_move_down(nav_gpkg, final_POIs, nsegments, filter(nhd_Final, !is.na(POI_ID)), "Type_Gages", .05)
- out_HUC12 <- POI_move_down(nav_gpkg, out_gages$allPOIs, out_gages$segs, out_gages$FL, "Type_HUC12", .10)
-
+ out_HUC12 <- POI_move_down(nav_gpkg, final_POIs, nsegments, filter(nhd_Final, !is.na(POI_ID)), "Type_HUC12", .10)
+ out_gages <- POI_move_down(nav_gpkg, out_HUC12$allPOIs, out_HUC12$segs, out_HUC12$FL, "Type_Gages", .05)
+
# Convert empty strings to NA for handling within R
- out_HUC12$allPOIs <- mutate_all(out_HUC12$allPOIs, list(~na_if(.,"")))
+ out_gages$allPOIs <- mutate_all(out_gages$allPOIs, list(~na_if(.,"")))
nhd_Final <- select(nhd_Final, -POI_ID) %>%
left_join(st_drop_geometry(out_HUC12$FL) %>%
select(COMID, POI_ID), by = "COMID")
# Write out geopackage layer representing POIs for given theme
- write_sf(out_HUC12$allPOIs, nav_gpkg, final_poi_layer)
+ write_sf(out_gages$allPOIs, nav_gpkg, final_poi_layer)
write_sf(nhd_Final, nav_gpkg, nhd_flowline)
- write_sf(out_HUC12$segs, nav_gpkg, nsegments_layer)
+ write_sf(out_gages$segs, nav_gpkg, nsegments_layer)
- nsegments <- out_HUC12$segs
- final_POIs <- out_HUC12$allPOIs
+ nsegments <- out_gages$segs
+ final_POIs <- out_gages$allPOIs
} else {
final_POIs <- read_sf(nav_gpkg, final_poi_layer)
nhd_Final <- read_sf(nav_gpkg, nhd_flowline)