Skip to content

Commit 383ed80

Browse files
dkopp3dkopp3
committed
updated tools to incorporate Measure, added net_flow for flow metrics
1 parent 4dfdf40 commit 383ed80

18 files changed

Lines changed: 770 additions & 463 deletions

‎Example_Data/Sample_Locations.csv‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
SiteName,StreamName,N,W,VPU
2+
SC2,Sycamore Creek,33.86396,-111.4655,15
3+
SC3,Sycamore Creek,33.78711,-111.50788,15
4+
WC1,Workman Creek,33.83373,-110.95091,15
5+
WC2,Workman Creek,33.84628,-110.9681,15
6+
WC3,Workman Creek,33.84776,-110.98302,15
7+
CC2,Carrizo Creek,37.16442,-103.03109,11
8+
CC3,Carrizo Creek,37.13483,-103.01728,11
9+
MC1,Jimmy Creek,34.81536,-98.58271,11
10+
MC2,Jimmy Creek,34.7972,-98.58433,11
11+
MC3,Medicine Creek,34.77091,-98.58141,11
12+
KR1,Upper Kiamichi River,34.67789,-94.46922,11
13+
KR2,Upper Kiamichi River,34.67746,-94.48624,11
14+
KR3,Upper Kiamichi River,34.66721,-94.535,11
15+
SS1,Troublesome Branch,32.9778,-87.4146,03W
16+
SS2,Mayfield Creek,32.9683,-87.408,03W
17+
SS3,South Sandy Creek,32.9661,-87.3919,03W
18+
TC,Terlingua Creek,29.20012,-103.60625,13

‎StreamNetworkTools.docx‎

5.02 KB
Binary file not shown.

‎StreamNetworkTools/DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,4 +14,4 @@ Imports: foreign,
1414
rgdal,
1515
rgeos,
1616
dplyr
17-
RoxygenNote: 6.0.1
17+
RoxygenNote: 6.1.0

‎StreamNetworkTools/NAMESPACE‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,13 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
export(cat_shp)
34
export(net_calc)
45
export(net_cat)
56
export(net_clim)
67
export(net_comid)
78
export(net_conflu)
89
export(net_delin)
10+
export(net_flow)
911
export(net_hort)
1012
export(net_lc)
1113
export(net_nhdplus)

‎StreamNetworkTools/R/net_calc.r‎

Lines changed: 81 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -29,91 +29,118 @@
2929
#'
3030
#' @export
3131

32-
net_calc <- function(netdelin, vpu, nhdplus_path ){
32+
net_calc <- function(netdelin, vpu, nhdplus_path){
3333
directory <- grep(paste(vpu, "/NHDPlusAttributes", sep = ""),
3434
list.dirs(nhdplus_path, full.names = T),
3535
value = T)
3636
Vaa <- grep("PlusFlowlineVAA.dbf",
37-
list.files(directory[1],full.names=T),
37+
list.files(directory[1], full.names = T),
3838
value = T)
3939
slope <- grep("elevslope.dbf",
40-
list.files(directory, full.names=T),
40+
list.files(directory, full.names = T),
4141
value = T)
42-
flow.files <- grep("PlusFlow.dbf", list.files(directory[1],
43-
full.names = T), value = T)
42+
flow.files <- grep("PlusFlow.dbf",
43+
list.files(directory[1], full.names = T),
44+
value = T)
45+
4446
flow <- foreign::read.dbf(flow.files)
4547
vaa <- foreign::read.dbf(Vaa)
4648
slope <- foreign::read.dbf(slope)
4749
names(slope) <- toupper(names(slope))
4850
names(vaa) <- toupper(names(vaa))
51+
4952
full.net <- unique(netdelin$Network)
50-
reach.data <- Reduce(function(x, y) merge(x, y,
51-
by.x = "net.comid",
52-
by.y = "COMID",
53-
all.x = T),
54-
list(full.net, vaa, slope))
53+
54+
reach.data <- Reduce(function(x, y)
55+
merge(x, y, by.x = "net.comid", by.y = "COMID", all.x = T),
56+
list(full.net, vaa, slope))
57+
5558
#calculate network order
56-
WS.ord <- aggregate(reach.data[, "STREAMORDE"],
57-
by = list(group.comid = reach.data[, "group.comid"]),
58-
max)
59-
names(WS.ord) <- c("COMID", "WS.ord")
59+
WS.ord <- reach.data[as.character(reach.data[,"group.comid"]) ==
60+
as.character(reach.data[,"net.comid"]),
61+
c("net.id","M", "STREAMORDE")]
62+
63+
names(WS.ord) <- c("net.id", "M", "WS.ord")
64+
6065
#catchemnts catchment area
66+
#group by, substract, multiply
67+
#value at end of flowline
6168
cat.area <- aggregate(reach.data[, c("AREASQKM", "LENGTHKM")],
62-
by = list(COMID = reach.data[, "group.comid"]),
69+
by = list(net.id = reach.data[, "net.id"],
70+
group.comid = reach.data[,"group.comid"]),
6371
sum)
64-
drain.den <- cat.area[ ,"LENGTHKM"] / cat.area[ ,"AREASQKM"]
72+
incr <- reach.data[as.character(reach.data[,"group.comid"]) ==
73+
as.character(reach.data[,"net.comid"]),
74+
c("net.id", "AREASQKM","LENGTHKM", "M")]
75+
76+
incr <- merge(incr, cat.area, by = "net.id")
77+
area <- (incr[,"AREASQKM.y"] - incr[,"AREASQKM.x"]) + incr[,"AREASQKM.x"]*incr[,"M"]
78+
len <- (incr[,"LENGTHKM.y"] - incr[,"LENGTHKM.x"]) + incr[,"LENGTHKM.x"]*incr[,"M"]
79+
80+
#scaled length and catchment vlaues
81+
cat.area <- data.frame(net.id = incr[,"net.id"],
82+
AreaSQKM = area, LengthKM = len)
83+
84+
drain.den <- cat.area[ ,"LengthKM"] / cat.area[ ,"AreaSQKM"]
6585
cat.area <- data.frame(cat.area, drain.den)
86+
6687
#diversion feature count
6788
#counts minor flow paths of divergences
68-
if (any(reach.data[,c("STREAMORDE")] != reach.data[,"STREAMCALC"] &
89+
if (any(reach.data[,c("STREAMORDE")] !=
90+
reach.data[,"STREAMCALC"] &
6991
reach.data[,"DIVERGENCE"]==2)){
92+
7093
div.rm <- reach.data[reach.data[,c("STREAMORDE")] !=
71-
reach.data[,"STREAMCALC"] & reach.data[, "DIVERGENCE"] == 2,
72-
c("net.comid", "group.comid")]
94+
reach.data[,"STREAMCALC"] &
95+
reach.data[, "DIVERGENCE"] == 2,
96+
c("net.id", "net.comid", "group.comid")]
7397

7498
diver.cnt <- aggregate(div.rm[, "group.comid"],
75-
by = list(div.rm[, "group.comid"]),
99+
by = list(div.rm[,"net.id"], div.rm[, "group.comid"]),
76100
length)
77-
names(diver.cnt) <- c("COMID", "diver.cnt")
78-
} else {
79-
diver.cnt<-data.frame(COMID=99999,diver.cnt=999999)
80-
}
101+
102+
names(diver.cnt) <- c("net.id", "diver.cnt")
103+
104+
} else {
105+
diver.cnt <- data.frame(net.id = 99999, diver.cnt = 999999)
106+
}
81107

82108
#headwaters & Tribs
83-
head.h2o <- aggregate(reach.data[reach.data[,"STARTFLAG"] == 1,
84-
"STREAMORDE"],
85-
by = list(group.comid =
86-
reach.data[reach.data[,"STARTFLAG"] ==
87-
1, "group.comid"]),
88-
length)
89-
names(head.h2o) <- c("COMID","head.h2o")
90-
trib.jun <- as.numeric(as.character(head.h2o[,"head.h2o"])) - 1
109+
head.h2o <- aggregate(reach.data[
110+
reach.data[,"STARTFLAG"] == 1, "STREAMORDE"],
111+
by = list(reach.data[reach.data[,"STARTFLAG"] == 1, "net.id"]),
112+
length)
113+
114+
names(head.h2o) <- c("net.id", "head.h2o")
115+
116+
trib.jun <- as.numeric(as.character(head.h2o[, "head.h2o"])) - 1
91117
head.h2o <- data.frame(head.h2o, trib.jun)
92118

93119
#edge count
94-
edges <- head.h2o[,"head.h2o"]+head.h2o[,"trib.jun"]
95-
reach.cnt <- data.frame(COMID = head.h2o[,"COMID"], reach.cnt = edges)
96-
names(reach.cnt) <- c("COMID", "reach.cnt")
97-
98-
#relief
99-
maxelev <- aggregate(reach.data[,"MAXELEVSMO"],
100-
by = list(reach.data[,"group.comid"]),
101-
max)
102-
minelev <- aggregate(reach.data[, "MINELEVSMO"],
103-
by = list(reach.data[, "group.comid"]),
104-
min)
105-
relief <- maxelev[,"x"]-minelev[,"x"]
106-
relief <- data.frame(COMID = maxelev[,"Group.1"],
107-
maxelev = maxelev[,"x"],
108-
minelev = minelev[,"x"],
109-
releif = relief)
120+
edges <- head.h2o[,"head.h2o"] + head.h2o[,"trib.jun"]
121+
reach.cnt <- data.frame(net.id = head.h2o[,"net.id"], reach.cnt = edges)
122+
123+
#relief - at outlet; I want to move this to basin metric
124+
#maxelev <- aggregate(reach.data[,"MAXELEVSMO"],
125+
# by = list(reach.data[,"group.comid"]),
126+
# max)
127+
#minelev <- aggregate(reach.data[, "MINELEVSMO"],
128+
# by = list(reach.data[, "group.comid"]),
129+
# min)
130+
#relief <- maxelev[,"x"]-minelev[,"x"]
131+
#relief <- data.frame(COMID = maxelev[,"Group.1"],
132+
# maxelev = maxelev[,"x"],
133+
# minelev = minelev[,"x"],
134+
# releif = relief)
110135

111136
#aggregate table for summaries of group comid
112-
data.out <- as.data.frame(unique(full.net[, c("group.comid", "vpu")]))
113-
names(data.out)[1] <- "COMID"
114-
data.out<-Reduce(function(x, y) merge(x, y,
115-
by = "COMID",
116-
all.x = T),
117-
list(data.out, relief, head.h2o, cat.area, WS.ord, reach.cnt, diver.cnt))
137+
data.out <- unique(full.net[, c("net.id","group.comid", "vpu")])
138+
139+
names(data.out)[2] <- "COMID"
140+
141+
data.out <- Reduce(function(x, y)
142+
merge(x, y, by = "net.id", all.x = T),
143+
list(data.out, WS.ord,head.h2o, reach.cnt, diver.cnt, cat.area))#, relief))
144+
118145
return(data.out)
119146
}

0 commit comments

Comments
 (0)