Skip to content
Snippets Groups Projects
Commit 741ad7a0 authored by Bock, Andy's avatar Bock, Andy
Browse files

Fixed tt, updated waterbodies

parent a63c8696
No related branches found
No related tags found
1 merge request!126Mods to Navigate - TT and waterbodies
Hide whitespace changes
Inline Side-by-side
workspace/02_NHD_navigate.Rmd
+ 43
− 56
View file @ 741ad7a0
......@@ -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)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment