0

This comes from the solution of another question. I have a network of polylines representing a river network, where I am working to make a calculation at each point on the polyline, based on some of some information from the downstream segments. In the example here, I have 5 river segments, segments 1-5. Each segment has 5 nodes on it (index). The connection between nodes are dictated by the ix (giver) and ixc (receiver) value. The distance along each segment moving upstream is stored in seg.dist (0 at the outlet, 40 at the top), and the distance from the network outlet, or root, stored in net.dist. The total distance upstream of each segment is stored in up.dist. y, z just contains values for mapping. n and k are constants.

I am trying to use the segmentParent value as an index of what h0 value to use in the function shown below (h.orig), instead of just iterating based off of i. h is calculated for every point on segment 1, then we move to segment 2 where the greatest value of h from segment 1 is used for the h0 value. Segment 3 is also based off the maximum h value calculated from segment 1. Segment 3 and segment 4 are instead based off of the maximum h value from segment 2. As the function stands now, h0 is defined as the maximum h from the segment i-1. This isn't always the case as some segments serve as the parent for > 1 segment.

The data frame looks like:

library(tidyverse)
segment <- rep(1:5, each = 5)
index <- rep(1:5, times = 5)
ix <- 1:25
ixc <- c(0,1,2,3,4,5,6,7,8,9,5,11,12,13,14,10,16,17,18,19,10,21,22,23,24)
seg.dist <- rep(c(0,10,20,30,40), times = 5)
net.dist <- c(0,10,20,30,40,40,50,60,70,80,40,50,60,70,80,80,90,100,110,120,80,90,100,110,120)
up.dist <- c(400,400,400,400,400,200,200,200,200,200,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
y <-c(0,0,0,0,0,0,1,1,1,1,0,-1.2,-1.4,-1.6,-1.8,1,1.2,1.4,1.6,1.8,1,0.8,0.6,0.4,0.2)
z <- c(1,2,3,4,5,5,6,7,8,9,5,7,9,11,13,9,10,11,12,13,9,11,13,15,17)

df <- data.frame(segment, index, ix, ixc, seg.dist, net.dist,up.dist,y, z) %>% 
  mutate(segment = factor(segment)) %>% 
  mutate(n = 0.5, k = 1500) %>% 
  mutate(segmentParent = c(0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2))

> df
   segment index ix ixc seg.dist net.dist up.dist    y  z   n    k segmentParent
1        1     1  1   0        0        0     400  0.0  1 0.5 1500             0
2        1     2  2   1       10       10     400  0.0  2 0.5 1500             0
3        1     3  3   2       20       20     400  0.0  3 0.5 1500             0
4        1     4  4   3       30       30     400  0.0  4 0.5 1500             0
5        1     5  5   4       40       40     400  0.0  5 0.5 1500             0
6        2     1  6   5        0       40     200  0.0  5 0.5 1500             1
7        2     2  7   6       10       50     200  1.0  6 0.5 1500             1
8        2     3  8   7       20       60     200  1.0  7 0.5 1500             1
9        2     4  9   8       30       70     200  1.0  8 0.5 1500             1
10       2     5 10   9       40       80     200  1.0  9 0.5 1500             1
11       3     1 11   5        0       40       0  0.0  5 0.5 1500             1
12       3     2 12  11       10       50       0 -1.2  7 0.5 1500             1
13       3     3 13  12       20       60       0 -1.4  9 0.5 1500             1
14       3     4 14  13       30       70       0 -1.6 11 0.5 1500             1
15       3     5 15  14       40       80       0 -1.8 13 0.5 1500             1
16       4     1 16  10        0       80       0  1.0  9 0.5 1500             2
17       4     2 17  16       10       90       0  1.2 10 0.5 1500             2
18       4     3 18  17       20      100       0  1.4 11 0.5 1500             2
19       4     4 19  18       30      110       0  1.6 12 0.5 1500             2
20       4     5 20  19       40      120       0  1.8 13 0.5 1500             2
21       5     1 21  10        0       80       0  1.0  9 0.5 1500             2
22       5     2 22  21       10       90       0  0.8 11 0.5 1500             2
23       5     3 23  22       20      100       0  0.6 13 0.5 1500             2
24       5     4 24  23       30      110       0  0.4 15 0.5 1500             2
25       5     5 25  24       40      120       0  0.2 17 0.5 1500             2

Segments with no parents (segment 1, where h0 and h are initialized), have a segmentParent value of 0.

As the function stands now, it looks like:

h.orig <- function(seg, h0 = 10, n, seg.dist, k, up.dist, output = c("h", "h0")){
  ctrl <- c(0, diff(seg))
  h <- list(h = numeric(), h0 = numeric())
  j = 1
  for(i in seq_along(seg)) {
    if(ctrl[i] > 0) {
      h0 = max(h[[1]][j:(i-1)])
      j = i
    }
    h[[1]][i] <- sqrt(h0^2 + ((n[i]*seg.dist[i])/k[i])*(2*up.dist[i] - seg.dist[i]))
    h[[2]][i] <- h0
  }
  if(length(output) == 1) return(h[[output]]) else return(h[output]) 
}

df.res <- df %>%
  mutate(h = h.orig(segment, h0 = 10, n, seg.dist, k, up.dist, "h"),
         h0 = h.orig(segment, h0 = 10, n, seg.dist, k, up.dist, "h0"))

> df.res
   segment index ix ixc seg.dist net.dist up.dist    y  z   n    k segmentParent        h       h0
1        1     1  1   0        0        0     400  0.0  1 0.5 1500             0 10.00000 10.00000
2        1     2  2   1       10       10     400  0.0  2 0.5 1500             0 10.13081 10.00000
3        1     3  3   2       20       20     400  0.0  3 0.5 1500             0 10.25671 10.00000
4        1     4  4   3       30       30     400  0.0  4 0.5 1500             0 10.37786 10.00000
5        1     5  5   4       40       40     400  0.0  5 0.5 1500             0 10.49444 10.00000
6        2     1  6   5        0       40     200  0.0  5 0.5 1500             1 10.49444 10.49444
7        2     2  7   6       10       50     200  1.0  6 0.5 1500             1 10.55620 10.49444
8        2     3  8   7       20       60     200  1.0  7 0.5 1500             1 10.61446 10.49444
9        2     4  9   8       30       70     200  1.0  8 0.5 1500             1 10.66927 10.49444
10       2     5 10   9       40       80     200  1.0  9 0.5 1500             1 10.72070 10.49444
11       3     1 11   5        0       40       0  0.0  5 0.5 1500             1 10.72070 10.72070
12       3     2 12  11       10       50       0 -1.2  7 0.5 1500             1 10.71914 10.72070
13       3     3 13  12       20       60       0 -1.4  9 0.5 1500             1 10.71448 10.72070
14       3     4 14  13       30       70       0 -1.6 11 0.5 1500             1 10.70670 10.72070
15       3     5 15  14       40       80       0 -1.8 13 0.5 1500             1 10.69579 10.72070
16       4     1 16  10        0       80       0  1.0  9 0.5 1500             2 10.72070 10.72070
17       4     2 17  16       10       90       0  1.2 10 0.5 1500             2 10.71914 10.72070
18       4     3 18  17       20      100       0  1.4 11 0.5 1500             2 10.71448 10.72070
19       4     4 19  18       30      110       0  1.6 12 0.5 1500             2 10.70670 10.72070
20       4     5 20  19       40      120       0  1.8 13 0.5 1500             2 10.69579 10.72070
21       5     1 21  10        0       80       0  1.0  9 0.5 1500             2 10.72070 10.72070
22       5     2 22  21       10       90       0  0.8 11 0.5 1500             2 10.71914 10.72070
23       5     3 23  22       20      100       0  0.6 13 0.5 1500             2 10.71448 10.72070
24       5     4 24  23       30      110       0  0.4 15 0.5 1500             2 10.70670 10.72070
25       5     5 25  24       40      120       0  0.2 17 0.5 1500             2 10.69579 10.72070

Ideally, the solution I am looking for would replace the i-1 linear referencing scheme for updating h0 and replace it with something that takes the segment id from segmentParent column, finds the maximum h across all indices on that segment, and updates h0 as that maximum h value. The calculation starts at segment 1, so it shouldn't be too difficult to crawl up the network from there, as all segment ids will be >1 and for all upstream segments, say q, then the parentSegment id will be < q.

This is obviously incorrect but just to visual what I am thinking in terms of a solution:

fun.new <- function(seg, segmentParent, h0 = 10, n, seg.dist, k, up.dist, output = c("h", "h0")){
  ctrl <- c(0, diff(seg))
  h <- list(h = numeric(), h0 = numeric())
  j = 1
  for(i in seq_along(seg)) {
    if(ctrl[i] > 0) {
      h0 = max(h[[1]][segmentParent])
      j = i
    }
    h[[1]][i] <- sqrt(h0^2 + ((n[i]*seg.dist[i])/k[i])*(2*up.dist[i] - seg.dist[i]))
    h[[2]][i] <- h0
  }
  if(length(output) == 1) return(h[[output]]) else return(h[output]) 
}
1
  • 2
    You had tags for ArcGIS Desktop and it’s Network Analyst extension but make no mention of how they are relevant to your question so I removed them.
    – PolyGeo
    Mar 8 '21 at 20:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.