Recursive network coding

[VBAhole22]

This problem is keeping me up at night because it seems easy but just gets harder and harder. Here goes: I have a db where each record is a segment of river with nodes at each end. Each record has a from node and a to node. Some records have a value in the waterbody field to designate that they are in a lake (centerline).

Fnode
Tnode
Wb
ArcID

So the question is how can I find the distance to and id of the closest waterbody to each arc?

Well I wrote a simple routine that walks along the river by starting at the first record in the table and leap frogging down successive arcs:

rstNode.Open "SELECT * from clinch WHERE TNODE_ = " & Fnode, cnn, adOpenStatic

Fnode = rstNode!FNODE_

until it reaches a wb and then snags the distance and id. It works great. But the key point is that it walks DOWN the stream. Now I want to go upstream to find the closest upstream waterbody.

Like an idiot I thought I could just flip things around and voila!

No dice. Going upstream is a whole different ballgame because the above query returns multiple records (downstream it doesn't until you reach the last arc).

So the trick is how do I follow each and every arc returned by the above query until it reaches a waterbody and then compare the distances?

Is this what recursive means?

 

[WayneRyan]

VBA,

Yup, that's recursive alright.

It's only been a few years, but this should give
you a start.

'
' Main Code
'
' We are at a distinct point (Fnode, Tnode)
'
' The global variables will contain the nearest
' waterbody ...
' 
Dim NearestFnode As Long
Dim NearestTnode As Long
Dim NearestDist As Long

x = FindDist(Fnode, Tnode)

'
' For each call there are three events.
'  No Parents - Exit
'  Parent (not waterbody) - Recurse
'  Parent (waterbody) - Assign to globals above and exit
'
'  Note:  The return value can be omitted
'
Public Function FindDist(Fnode, Tnode) As Long
Dim dbs As Database
Dim rst As Recordset
Dim sql As String
'
' Find next upstream nodes
'
sql = "Select * From clinch Where Fnode = " & Tnode
Set rst = dbs.OpenRecordset(sql)
'
' If none, search is over return 0
'
If rst.EOF and rst.BOF Then
   FindDist = 0
   Exit Function
End If
'
' Now process each child
'
While Not rst.EOF and Not rst.BOF
   '
   ' If a waterbody, return distance
   ' 
   If rst!wb = "Y" Then
      If rst!ArcID < NearestDist Then
         NearestFnode= rst!Fnode
         NearestTnode rst!Tnode
         NearestDist As rst!ArcID ' or however you compute distance
         FindDist = 0
      Exit Function
   End If
   '
   ' Otherwise, get its nearest waterbody distance ...
   '
   X = FindDist(Fnode, Tnode)
   Wend
   FindDist = 0
End Function

Just a quick stab at it. If you could post the completed
result, I'd be interested.

btw, Factorials & Directory structures are good examples of
recursive programming.

Wayne

 

[PookaTech]

Hello,

I have a question about the process being used. From time to time I want to look up values in a table I use Dlookup. I can imagine that it could be used here too.

I am wondering if the sql approach suggested here is faster. Is it usually faster to use sql to find a record and then reference a field in that record or is it just as fast to use Dlookup to find the value in the field of the record?

Anything that anyone has to offer on this would be great.

Thanks,
PookaTech

 

[WayneRyan]

VBA,

One addition to the above. When the function finds a water
body and calculates the distance, it should exit if the distance
is greater than the shortest found so far.

Pooka,
A DLookUp could be used in this example, but the search
by definition can return multiple paths. The DLookUp will
only return one. Also domain functions like that are inherently
slow.

Since the width and depth of the search tree is unknown
traditional SQL queries can't be applied.

Wayne

 

[VBAhole22]

Wow

Thanks Wayne,

Your code was just what I was looking for. I modified it slightly to fit my situation and it appears to be running like I want it to except in one area. The length of stream that I want to report at the end is the total of the length attributes of each arc that is located on the shortest path to the waterbody. For the downstream portion of the code it was sufficient to write:
length = length + rstNode!length
and have a running tally and report that at the end of the function. However, the code you supplied is cool in that it 'sniffs' up streams that don't end in waterbodies and discards them if they don't terminate in a waterbody. So this would preclude using a tally in the ordinary sense.
I'm including the code I am currently using in hopes that someone can come up with a solution to this issue. I think it can be done and I think it's right in front of me, maybe I will get it buy day's end, maybe not.
Basically, the jist of it now is how do I only tally lengths of arcs that are on the path that eventually terminates at a waterbody?
With these recursive issue sometimes it seems like your program needs to make decisions based on information that you don't know initially but that you will know eventually down the line of the code process. Makes it a bit confusing. But this forum obviously has some of the brightest people in the world, as evidenced by your speedy and accurate intial response.

Thanks again.

Oh, one other note. I didn't really provide you with a whole lot of info in the initial post. I restructured your function to be called from just an Fnode. I guess in the end it only needs to be called once for the whole stream network if you are starting at the 'pour point' (the arc where all other arcs drain). Not sure about that assumption yet though.


Sub AccessForum()
Dim Fnode As String, Tnode As String, X

Fnode = "2690"

X = FindDist(Fnode)

Debug.Print NearestDist
End Sub
Public Function FindDist(Fnode As String) As Long
Dim dbs As Database
Dim rst As Recordset
Dim sql As String
Dim X
Dim cnn As New ADODB.Connection, rstNode As New ADODB.Recordset, length As Double
Set cnn = CurrentProject.Connection
Dim NextUp As String

' Find next upstream nodes

rstNode.Open "SELECT * from clinch WHERE TNODE_ = " & Fnode, cnn, adOpenStatic

' If none, search is over return 0

If rstNode.RecordCount = 0 Then
FindDist = 0
Exit Function
End If

' Now process each child

While Not rstNode.EOF And Not rstNode.BOF

' If a waterbody, return distance

If Not IsNull(rstNode!WB_TYPE) Then
NearestFnode = rstNode!Fnode_
NearestTnode = rstNode!WB_ID
NearestDist = rstNode!length
FindDist = 0
Exit Function
End If

' Otherwise, get its nearest waterbody distance ...

NextUp = rstNode!Fnode_
X = FindDist(NextUp)
rstNode.MoveNext
Wend
FindDist = 0
End Function

 

[WayneRyan]

VBA,

Rats, I knew it! It just couldn't be possible to calculate the
distance from just the two end nodes ... My assumption was that
it could be done, that's why the function didn't use the return
value; just globally knew the "current situation".

It gives me headaches to think about recursion, but I think
what you need is to call the function initially like:

Distance = FindDist(Fnode, Current)

The function would find the children (parents?) and iterate
through them.

We need to make the function a variant as it should return
the Distance and the Node.

Public Sub FindDist(FNode, CurrentDistance, ShortestSoFar)
' Where CurrentDistance is initially 0 and ShortestSoFar is very large.
Dim dbs As Database 
Dim rst As Recordset 
Dim sql As String 
Dim MyShortestNode As Long
Dim MyShortestSoFar As Long
Dim MyDistance As Long
'
' Remember which child is "best"
'
MyShortestSoFar = ShortestSoFar
MyShortestNode = 0

Dim cnn As New ADODB.Connection, rstNode As New ADODB.Recordset, length As Double 
Set cnn = CurrentProject.Connection 

' Find next upstream nodes 

rstNode.Open "SELECT * from clinch WHERE TNODE_ = " & Fnode, cnn, adOpenStatic 

' If none, we have no waterbodies

If rstNode.RecordCount = 0 Then 
   FindDist = 99999
   Exit Function 
End If 

' Now process each child 

While Not rstNode.EOF And Not rstNode.BOF 
   ' If a waterbody, return distance 
   If Not IsNull(rstNode!WB_TYPE) Then 
     MyDistance = CurrentDistance + rstNode!length
      ' Is it a Keeper?
      If MyDistance < ShortestSoFar Then
         MyShortestNode = rstNode!Fnode
         MyShortestSoFar = MyDistance
      Else
         ' Do nothing
      End If
   ' Otherwise, get its nearest waterbody distance ... 
   Else
      MyDistance = FindDist(rstNode!Fnode_, CurrentDistance, CurrentDistance)
      If MyDistance < ShortestSoFar Then
         ' We need multi-returns
         ' MyShortestNode = rstNode!Fnode
         MyShortestSoFar = MyDistance
      Else
         ' Do nothing
      End If
   End If
   rstNode.MoveNext 
   Wend 
' We've gone thru all children, are any good
If MyShortestNode = 0 Then
   FindDist = 99999
   Exit Function
Else
   FindDist = MyShortestSoFar
   ' Also MyShortestNode is end node
   Exit Function
End If
End Function

further along,
Wayne

 

[WayneRyan]

VBA,

I hope this is it ...

Public Type Location
    Node As Long
    Distance As Long
End Type

Private Sub Main
'
' Your main routine ...
'
Dim TheNode As Location
TheNode = FindDist(ThisNode, 0, 99999)
If TheNode.Node = 0 Then
   MsgBox("There aren't any!")
Else
   MsgBox("Shortest is " & TheNode.Node & " - " & TheNode.Distance)
End If
End Main


Public Sub FindDist(FNode, CurrentDistance, ShortestSoFar) As Location
' Where CurrentDistance is initially 0 and ShortestSoFar is very large.
Dim dbs As Database 
Dim rst As Recordset 
Dim sql As String 
Dim MyShortestNode As Long
Dim MyShortestSoFar As Long
Dim MyDistance As Long
'
' Remember which child is "best"
'
MyShortestSoFar = ShortestSoFar
MyShortestNode = 0

Dim cnn As New ADODB.Connection, rstNode As New ADODB.Recordset, length As Double 
Set cnn = CurrentProject.Connection 

' Find next upstream nodes 

rstNode.Open "SELECT * from clinch WHERE TNODE_ = " & Fnode, cnn, adOpenStatic 

' If none, we have no waterbodies

If rstNode.RecordCount = 0 Then 
   FindDist.Distance = 99999
   FindDist.Node = 0
   Exit Function 
End If 

' Now process each child 

While Not rstNode.EOF And Not rstNode.BOF 
   ' If a waterbody, return distance 
   If Not IsNull(rstNode!WB_TYPE) Then 
     MyDistance = CurrentDistance + rstNode!length
      ' Is it a Keeper?
      If MyDistance < ShortestSoFar Then
         MyShortestNode = rstNode!Fnode
         MyShortestSoFar = MyDistance
      Else
         ' Do nothing
      End If
   ' Otherwise, get its nearest waterbody distance ... 
   Else
      MyDistance = FindDist(rstNode!Fnode_, CurrentDistance, CurrentDistance)
      If MyDistance < ShortestSoFar Then
         ' We need to save multi-values
         MyShortestNode = rstNode!Fnode
         MyShortestSoFar = MyDistance
      Else
         ' Do nothing
      End If
   End If
   rstNode.MoveNext 
   Wend 
' We've gone thru all children, are any good
If MyShortestNode = 0 Then
   FindDist.Distance = 99999
   FindDist.Node = 0
   Exit Function
Else
   FindDist.Distance = MyShortestSoFar
   FindDist.Node = MyShortestNode
   Exit Function
End If
End Function

Let me know,
Wayne

 

[VBAhole22]

Getting there

Well it's almost where I need it to be. I had to make some modfifications to the last bit you posted. I think you might have just mistyped but I could be wrong. I changed your line of :

MyDistance = FindDist(rstNode!Fnode_, CurrentDistance, CurrentDistance)

to

MyDistance = FindDist(rstNode!Fnode_, CurrentDistance, ShortestSoFar)

And also Access wouldn't compile the above call to the function of the custom datatype, so I revamped it to:

MyLocation = FindDist(rstNode!FNode_, CurrentDistance, ShortestSoFar)
MyDistance = MyLocation.Distance

with a dim for
Dim MyLocation As Location


I hope I got that part correct. Before I made the first fix it was always saying 'there aren't any'

Now it does find the wb but it only reports the length as that of the last arc (the one where wb!type is not null).

Seems to me that there needs to be a storage mechanism for arc lengths even if they don't meet the Not isNull (rstNode!WB_TYPE) criteria.

And you are absolutely right about the aspirin bottle!

When i first read your last response I got an idea that if I knew the first node (the one I call with) and I knew the last node (the wb node) I should be able to get the straight line path between the 2 along with the length. But alas, I didn't have the answer.

It seems to be right there. And I'm not doing anything to help but plugging you for answers. Guess I need to stare at it more and more and more.

Here is what I have now. I tacked on a sample table to run against.
Wayne, I greatly appreciate your help. I had been struggling for a while now about how to get functions to return multiple values and your example finally made something in my brain click, so I have learned much so far. Thanks again.


Public Type Location
Node As Long
Distance As Long
End Type

Sub Main()

Dim ThisNode As Double
ThisNode = 2622
'
' Your main routine ...
'
Dim TheNode As Location
TheNode = FindDist(ThisNode, 0, 99999)
If TheNode.Node = 0 Then
MsgBox ("There aren't any!")
Else
MsgBox ("Shortest is " & TheNode.Node & " with a total distance of " & TheNode.Distance)
End If
End Sub


Public Function FindDist(FNode As Double, CurrentDistance As Long, ShortestSoFar As Long) As Location
' Where CurrentDistance is initially 0 and ShortestSoFar is very large.
Dim dbs As Database
Dim rst As Recordset
Dim sql As String
Dim MyShortestNode As Long
Dim MyShortestSoFar As Long
Dim MyDistance As Long
Dim MyLocation As Location
'
' Remember which child is "best"
'
MyShortestSoFar = ShortestSoFar
MyShortestNode = 0

Dim cnn As New ADODB.Connection, rstNode As New ADODB.Recordset, length As Double
Set cnn = CurrentProject.Connection

' Find next upstream nodes

rstNode.Open "SELECT * from clinch WHERE TNODE_ = " & FNode, cnn, adOpenStatic

' If none, we have no waterbodies

If rstNode.RecordCount = 0 Then
FindDist.Distance = 99999
FindDist.Node = 0
Exit Function
End If

' Now process each child

While Not rstNode.EOF And Not rstNode.BOF
' If a waterbody, return distance
If Not IsNull(rstNode!WB_TYPE) Then
MyDistance = CurrentDistance + rstNode!length
' Is it a Keeper?
If MyDistance < ShortestSoFar Then
MyShortestNode = rstNode!FNode_
MyShortestSoFar = MyDistance
Else
' Do nothing
End If
' Otherwise, get its nearest waterbody distance ...
Else
'MyDistance = FindDist(rstNode!Fnode_, CurrentDistance, CurrentDistance)
MyLocation = FindDist(rstNode!FNode_, CurrentDistance, ShortestSoFar)
MyDistance = MyLocation.Distance
If MyDistance < ShortestSoFar Then
' We need to save multi-values
MyShortestNode = rstNode!FNode_
MyShortestSoFar = MyDistance
Else
' Do nothing
End If
End If
rstNode.MoveNext
Wend
' We've gone thru all children, are any good
If MyShortestNode = 0 Then
FindDist.Distance = 99999
FindDist.Node = 0
Exit Function
Else
FindDist.Distance = MyShortestSoFar
FindDist.Node = MyShortestNode
Exit Function
End If
End Function

 

[WayneRyan]

VBA,

Here's the latest. It still doesn't work, but its a step
further. I made a form and put the code in the OnClick
behind the control.

I ran it for:

2622
   2727     5304 units
      2718   434 units
   2544     4679 units

It returns the distance correctly (5,740), but returns the
wrong node.

Anyway, I've had enough fun for today. Just thought I'd post
it and maybe save you some time.

If you run it with the debugger, it sure looks OK. Just need
more time and a bigger pad of paper to keep track of it.

Wayne

 

[WayneRyan]

Hi, its me again!

I think I'm done.

Every break that I had I found myself looking at this thing.
I was getting to the point that I didn't know upstream from
downstream.

I tested it on 2180 and in my eyes it works.

Let me know ...
Wayne

 

[VBAhole22]

Gracias!!!

Wayne you are a saint among men!!

Not only does it work, it's fast!!

I tested it on a drainage that at about 1000 arcs and it returns the results immediately.

I can't thank you enough. You spared me more sleepless nights pondering this thing.

It's going to take me a week or 2 to figure out how you did it. I guess the level tracking is what made the difference? I can't tell yet. But I know it works and I am grateful.

Any reason you chose DAO over ADO. I think I will nodify that part as a step in my DAO weening phase.

So in summary: in one brief week you taught me about recursion, custom data types, export to log files (didn't know that one yet) and network analysis. You deserve an A++

I'll be doing my best to attach your name to this code and deflect all credit away from myself, you did the grunt work while I waited, stumped.

THANK YOU!!!!!!!!!!!!!!!!!

 

[WayneRyan]

VBA,

More than happy to have helped.

I put the Level in just to keep track for the log
file. It, with the indentation, lets you see how
the code traverses the tree.

I hadn't had to write anything recursive for a
few years, so it was good to revisit.

That kind of stuff can really drive you nuts,
so I think I will wait another few years before
diving in again.

I used DAO just because that is what I normally
use.

See ya,
Wayne

 

[hangglide]

I have a much simpler "recursive" question.

I have a stream network that does not have other waterbodies.

How would I go about constructing a recursive query that simply selected all upstream records from any given record?

My data have a the same tnode and fnode fields.

Thanks,
Leo

 

[WayneRyan]

Leo,

During this thread we were traversing data, summing up individual lengths.
It didn't matter how many nodes were traversed, and there wasn't a need to
record the path taken.

I'd have to break down and use a temporary table storing:

The Level number (might be useful)
The node's primary key.

Then you can just join the two in a query and retrieve all the information
you need, including the order.

Public Function GetParentRecord(SomeKey As Long, Level As Long) As Boolean
Dim NextKey As Long

  If Level = 1 Then
     DoCmd.RunSQL "Delete From TempTable"
  End If

  DoCmd.RunSQL "Insert Into TempTable (SomeKey, SomeLevel) Values (" & SomeKey & ", " & SomeLevel & ");"

  NextKey = Nz(DLookUp("[ParentPointer]", "YourTable", "[SomeKey] = " & SomeKey), "")
  If NextKey  <> "" Then
     rtnStatus = GetParentRecord(NextKey, Level + 1)
  End If

GetParentRecord = True
End Function

I hate to use a temp table, but any query-based approach has to have a static
number of joins.

Hope this helps,
Wayne

 

[hangglide]

Thanks Wayne,
You answer sounds like it might work. I will give it a try.

Leo

 

[hangglide]

Okay, Wayne. I am stumped. I have spent hours trying to implement your code. I am not exactly sure which "keys" go where.

I like the idea and I can live with the join after a temp table is created (if I could get that far). I am reworking the script (to try to understand it better). So far I can get the script to take a given input record id (from my "Stream" table), pull out the StreamID, FromNode and ToNode. I can get it to write that record back to the TempTable. I can't get it to traverse anything though.

Also, will the above script follow multiple tributaries or will it only follow one?

I will keep trying.

 

[WayneRyan]

Leo,

Darn, recursion can give you headaches.

First, if you are traversing a single "linked list", you have to think of the
problem as:

I am at a record, If I don't have a parent (add my name to list and I'm done),
If I do have a parent, add my name to the list and call this same routine with
my Parent's name.

Assume that you have a table as shown below. The lineage of any record can be
1,000 levels deep. You can't use a query to traverse it.

tblTest
=======
TheID - AutoNumber
MyParent - Long --> Pointer to the parent's "TheID" (0 at the end)
Whatever other info

If you want a list of all parent records, regardless of how "deep", you
have to store the list somewhere.

You can call a Public function like the one below and it will populate a temporary
table with the ID's (and order) of all of it's parents.

Public Function GetParentRecord(SomeKey As Long, Level As Long) As Boolean
Dim NextKey As Long
'
' If I'm called for the first time, clear the "list"
'
If Level = 1 Then
   DoCmd.RunSQL "Delete From TempTable"
End If
'
' Regardless of whether I have a parent or not, add me to the list.
'
DoCmd.RunSQL "Insert Into TempTable (SomeKey, SomeLevel) Values (" & SomeKey & ", " & SomeLevel & ");"
'
' Check for my parent, If I have one, make the recursive call with parent's ID (adding one to the level)
' If no parent, I've already added my name to the list and I'm done.
'
NextKey = Nz(DLookUp("[ParentPointer]", "YourTable", "[SomeKey] = " & SomeKey), "")
If NextKey  <> "" Then
   rtnStatus = GetParentRecord(NextKey, Level + 1)
End If

GetParentRecord = True
End Function

Wayne

 

[hangglide]

Yep, This is a tough one for me as I am not that good at VB. I looked closely at your code and I understand the concept.

I "pulled apart" you code and tried to recreate it myself just for learning reasons (and because for the life of me I can't call your function properly). ha

Here is what I have so far. It appears to work for a while until it hits a null value (although I can't tell if it is going up or down the tree). Then it crashes.

To me it looks much more confusing that the code you supplied! Oh well. I am still learning.

Thanks for your help.

Private Sub StartRecord_AfterUpdate()
  
  '--- Delete all records in the temporary table
  DoCmd.SetWarnings True
  DoCmd.RunSQL "Delete From TempTable"
  
  '--- Dim variables
  Dim StartNode As Long
  Dim NodeID As Long
  Dim NextNode As Long
  
  '--- Enter first row in temp table
  NodeID = Me.StartRecord
  StartNode = DLookup("ToNode", "Stream", "ARCID = " & NodeID)
  NextNode = DLookup("FromNode", "Stream", "ARCID = " & NodeID)
  UpdateTempTable = AddTempRecord(NodeID, StartNode, NextNode)
    
  '--- Traverse stream network and enter more rows in temp table
  traverse = TraverseUpstream(NodeID, StartNode, NextNode)
End Sub

Public Function AddTempRecord(ARCID As Long, ToNode As Long, FromNode As Long) As Boolean
  DoCmd.SetWarnings False
  DoCmd.RunSQL "Insert Into TempTable (ARCID, ToNode, FromNode) Values (" & ARCID & ", " & ToNode & ", " & FromNode & ");"
  DoCmd.SetWarnings True
  'AddTempRecord = True
End Function

Public Function TraverseUpstream(NodeID As Long, StartNode As Long, NextNode As Long) As Boolean
  NodeID = DLookup("ARCID", "Stream", "ToNode = " & NextNode)
  StartNode = DLookup("ToNode", "Stream", "ARCID = " & NodeID)
  NextNode = Nz(DLookup("FromNode", "Stream", "ARCID = " & NodeID), "0")
    If NextNode <> "0" Then
      UpdateTempTable = AddTempRecord(NodeID, StartNode, NextNode)
      traverse = TraverseUpstream(NodeID, StartNode, NextNode)
    End If
End Function

Also, I can't tell if it is looking up and down more than one branch of the tree. I doubt that it is. Is that what you mean by "levels?"

I have attached an example file. It used to be over 100,000 records so I cant gurantee that the tree still links in a valid way but it should be pretty good.

Leo

 

[WayneRyan]

Leo,

All You want to do is get the Node IDs (and hopefully their order).

Your temp table should only need the NodeID and the iteration #.

If you log the NodeID, FromNOde, ToNode, you'll have to reconstruct
it to make sense of the order.

I'm at a loss to understand why you're tracking all those things in
the temp table. All you want is a list of the NodeIDs on your way
to the end of the list.

In this instance, we are traversing a linked-list. It is only a
chain of nodes. Any particular node can have one/no parents and
one/no children.

If you want to traverse a tree structure, then each node will not
be able to consult ONE field in a record for lineage, they will have
to have traverse all parents/children in a recordset.

Need more information.

Wayne

 

[hangglide]

You are right. I don't need to keep track of the "from" and "to" nodes in my final temp table. The only reason I did it here was so that I could be sure it was working right. I really only need the ID field (ARCID). I can get the rest of the data from a join later. I just updated a previous post with an example database.

In this case they are actually streams. Each stream has a number of tributaries so there are some cases where a node will have more than one parent. For now it is getting late and I have to work tomorrow. I have already spent WAY to much time on this.

This analysis is actually a small part of a larger analysis. We need a way to tell if one node is within the watershed of another node. If it is we will compare some other data that we have (like you said) with a join.

Thanks again.

Leo