|
1 | | -#' Identify NHDPlus Catchment |
| 1 | +#' NHDPlus Catchment |
2 | 2 | #' |
3 | | -#' Extracts NHDPlus flowline catchments with optional dissolve |
| 3 | +#' Identifies catchments associated with network COMID |
4 | 4 | #' |
5 | | -#' Ploygons can be used to associate landscape attributes not included with |
6 | | -#' NHDPlus |
| 5 | +#' catchment ploygons can be used to associate landscape attributes to NHDPlusV2 |
| 6 | +#' flowlines (COMID). |
7 | 7 | #' |
8 | 8 | #' Requires NHDPlusCatchment directory |
9 | 9 | #' |
10 | | -#' Some comid's do not have matching catchment (featureID) and some catchments |
11 | | -#' do not have matching comid's (see |
12 | | -#' \url{http://www.horizon-systems.com/NHDPlus/NHDPlusV2_documentation.php}) |
| 10 | +#' see |
| 11 | +#' (\url{http://www.horizon-systems.com/NHDPlus/NHDPlusV2_documentation.php}) |
| 12 | +#' for information about Watershed boundary dataset and its use in NHDPlusV2 |
| 13 | +#' Only catchments matching network COMID are returned in sf object |
13 | 14 | #' |
14 | 15 | #' @param netdelin output form \code{link{net_delin}} |
15 | | -#' @param vpu the vector processing unit |
16 | | -#' @param nhdplus_path the directory containing NHDPlus data see(\code{net_nhdplus}) |
17 | | -#' @param dissolve collapse subcatchments to create a single network catchmet \code{(Y/N)} |
| 16 | +#' @param vpu NHDPlusV2 Vector Processing Unit |
| 17 | +#' @param nhdplus_path Directory containing NHDPlusV2 see (\code{net_nhdplus}) |
| 18 | +#' @param dissolve dissolve catchments \code{(Y/N)} |
18 | 19 | #' |
19 | | -#' @return named list: \code{$sf_obj} is simple features object and \code{$na_cat} records |
20 | | -#' comid's without catchment |
| 20 | +#' @return named list: \code{$sf_obj} is simple features object; |
| 21 | +#' \code{$group.comid} root COMID of network; \code{$net.comid} COMID upstream |
| 22 | +#' of root COMID; \code{vpu} NHDPlusV2 Vector Processing Unit. \code{$na_cat} |
| 23 | +#' contains comids without catchment \code{$na_cat} records comid's without |
| 24 | +#' catchment (see Details) |
21 | 25 | #' |
22 | 26 | #' @examples |
23 | | -#' d <- net_cat(netdelin = c, vpu = "01", nhdplus_path = getwd(), dissolve = "Y") |
24 | | -#' plot(st_geometry(d$sf_obj)) |
| 27 | +#' #' # identify NHDPlusV2 COMID |
| 28 | +#' a <- net_sample(nhdplus_path = getwd(), vpu = "01", ws_order = 6, n = 5) |
| 29 | +#' # delineate stream network |
| 30 | +#' b <- net_delin(group_comid = as.character(a[,"COMID"]), nhdplus_path = getwd(), vpu = "01") |
| 31 | +#' C <- net_cat(netdelin = b, vpu = "01", nhdplus_path = getwd(), dissolve = "N") |
| 32 | +#' #plot catchments |
| 33 | +#' plot(st_geometry(c$sf_obj)) |
| 34 | +#' #write sf object as shapefile |
| 35 | +#' sf::write(c$sf_obj, paste(getwd(),"c.shp",sep = "")) |
25 | 36 | #' @export |
26 | 37 |
|
27 | 38 | net_cat <- function(netdelin, vpu, nhdplus_path, dissolve){ |
28 | 39 |
|
29 | 40 | dir.spatial <- grep(paste(vpu, "/NHDPlusCatchment", sep = ""), |
30 | 41 | list.dirs(nhdplus_path, full.names = T), |
31 | 42 | value = T) |
32 | | - dir.spatial <- dir.spatial[grep("NHDPlusCatchment/",dir.spatial,invert=T)] |
| 43 | + dir.spatial <- dir.spatial[grep("NHDPlusCatchment/", dir.spatial, invert = T)] |
33 | 44 | catch <- sf::st_read(dir.spatial, layer = "Catchment") |
34 | | - names(catch)[c(1, 2)] <- toupper(names(catch)[c(1,2)]) |
| 45 | + names(catch)[c(1, 2)] <- toupper(names(catch)[c(1, 2)]) |
35 | 46 | #some networks do not have matching catchements |
36 | | - na.cat <- data.frame(vpu = character(), |
37 | | - group.comid = character(), |
38 | | - net.comid = character()) |
| 47 | + na.cat <- data.frame(vpu = character(), group.comid = character(), net.comid = character()) |
39 | 48 | ids <- netdelin$Network |
40 | 49 | count <- 1 |
41 | 50 |
|
42 | 51 | for (i in unique(ids[ ,"group.comid"])){ |
43 | 52 | group.comid <- as.character(i) |
44 | 53 | net.comid <- as.character(ids[ids[ ,"group.comid"] == i, "net.comid"]) |
45 | 54 | cat_comid <- dim(catch[catch$FEATUREID %in% net.comid, "FEATUREID"])[1] |
46 | | - na_len<-length(net.comid[net.comid %in% catch$FEATUREID == F]) |
47 | | - na.cat<-rbind(na.cat, |
48 | | - data.frame(net.comid = net.comid[net.comid %in% catch$FEATUREID == F], |
49 | | - group.comid = rep(group.comid,na_len), |
50 | | - vpu = rep(vpu,na_len))) |
| 55 | + na_len <- length(net.comid[net.comid %in% catch$FEATUREID == F]) |
| 56 | + na.cat <- rbind(na.cat, data.frame(net.comid = net.comid[net.comid %in% catch$FEATUREID == F], |
| 57 | + group.comid = rep(group.comid, na_len), |
| 58 | + vpu = rep(vpu, na_len))) |
51 | 59 | if (cat_comid > 0){ |
52 | 60 | if (count == 1) { |
53 | 61 | save.shp <- catch[catch$FEATUREID %in% net.comid, "FEATUREID"] |
54 | | - net.ids<-save.shp$FEATUREID |
| 62 | + net.ids <- save.shp$FEATUREID |
55 | 63 | save.shp <- lwgeom::st_make_valid(save.shp) |
56 | 64 | geom <- sf::st_geometry(save.shp) |
57 | | - save.shp <- sf::st_sf(geom, |
58 | | - data.frame(group.comid = rep(group.comid, cat_comid), |
59 | | - net.comid=net.ids, |
| 65 | + save.shp <- sf::st_sf(geom, data.frame(group.comid = rep(group.comid, cat_comid), |
| 66 | + net.comid = net.ids, |
60 | 67 | vpu = rep(vpu, cat_comid))) |
61 | 68 | } else { |
62 | 69 | temp <- catch[catch$FEATUREID %in% net.comid, "FEATUREID"] |
63 | 70 | net.ids <- temp$FEATUREID |
64 | 71 | temp <- lwgeom::st_make_valid(temp) |
65 | 72 | geom <- sf::st_geometry(temp) |
66 | | - temp <- sf::st_sf(geom, |
67 | | - data.frame(group.comid = rep(group.comid, cat_comid), |
68 | | - net.comid=net.ids, |
| 73 | + temp <- sf::st_sf(geom, data.frame(group.comid = rep(group.comid, cat_comid), |
| 74 | + net.comid = net.ids, |
69 | 75 | vpu = rep(vpu, cat_comid))) |
70 | 76 | save.shp <- rbind(save.shp, temp) |
71 | 77 | } |
72 | 78 | count <- count + 1 |
73 | 79 | } else { |
74 | | - net.comid<-NA |
| 80 | + net.comid <- NA |
75 | 81 | na.cat <- rbind(na.cat, cbind(vpu, group.comid, net.comid)) |
76 | 82 | } |
77 | 83 | } |
78 | | - if (dissolve=="Y"){ |
| 84 | + |
| 85 | + if (dissolve == "Y"){ |
79 | 86 | save.shp <- dplyr::group_by(save.shp, group.comid) |
80 | 87 | save.shp <- dplyr::summarise(save.shp, subcat_count = length(vpu)) |
81 | 88 | save.shp <- sf::st_cast(save.shp) |
82 | 89 | } |
| 90 | + |
83 | 91 | out.list <- list(sf_obj = save.shp, na_cat = na.cat) |
84 | 92 | return(out.list) |
85 | 93 | } |
0 commit comments