DCIprogram: #Dijkstra
" Exported from Squeak 7179-basic.226 last modified on 3 November 2014 by: Trygve"
projection: Context
Class: CalculateShortestPathCTX
Context subclass: #CalculateShortestPathCTX
instanceVariableNames: 'geometry tentativeDistanceDict unvisitedSet path destination origin current'
category: 'Dijkstra-Context'
" This Context computes the shortest path to all nodes from a given origin node, using recursion rather than a loop.
The result is a list of the shortest paths from origin to each of the other nodes. The list elements are associations (node -> distance).
This implementation roughly follows the Ruby algorithm with two known exceptions:
# Ruby has two coordinate systems: street/avenue and East/South. This implementation has has only East/South.
# The mechanism for computing the path is different from the Ruby solution.
We here use a simple mechanism illustrated in
http://www.youtube.com/watch?v=psg2-6-CEXg&feature=related
Unfortunately, this page has now been made private.
Also see the (role binding) DISTANCEDICT method in this class
# The EASTNEIGHBOR and SOUTHNEIGHBOR roles are regular roles with regular role methods.
# We use separate associative arrays (Dictionaries) for holding tentative distances etc. (No modules)
They are stored in the Context object since they represent state relevant to the Interaction.
# Some data need to be visible throughout the recursion.
We set these data in the recur method rather than in message arguments.
"
instanceMethods: initialize-release
initialize
super initialize.
tentativeDistanceDict := IdentityDictionary new. " node -> a TentativeDistance "
unvisitedSet := IdentitySet new.
instanceMethods: attributes-write
destination: anObject
"Set the value of destination"
destination := anObject
geometry: geom
" This is a first time initialization of key variables. "
" Not to be called on recursive calls. "
| pathTo tentDist |
geometry := geom.
geometry nodes do:
[:nod |
unvisitedSet add: nod.
tentDist := TentativeDistance new distance: Float infinity previousNode: nil.
tentDist thisNode: nod thisRoleName: nil.
tentativeDistanceDict at: nod put: tentDist.
].
path := OrderedCollection new.
pathTo := Dictionary new.
tentativeDistanceDict: anObject
tentativeDistanceDict := anObject
unvisitedSet: aSet
unvisitedSet := aSet
instanceMethods: operations
shortestPathFrom: originName to: destinationName
| node |
" Preamble before entering the interaction. "
origin := geometry nodeNamed: originName.
destination := geometry nodeNamed: destinationName.
(tentativeDistanceDict at: origin) distance: 0 previousNode: nil. " node -> a TentativeDistance "
" Enter recursive interaction algorithm: "
self triggerInteractionFrom: #CURRENTINTERSECTION with: #computeDistanceToNeighbors.
" Termination. "
" Build shortest path collection. "
path := OrderedCollection new.
node := destination.
[node notNil]
whileTrue:
[path addFirst: node -> (tentativeDistanceDict at: node) distance.
node := (tentativeDistanceDict at: node) previousNode].
^path
recur
| ctx |
self remap.
ctx := CalculateShortestPathCTX new.
" Ensure continuity through the recursion for critical variables. "
" Setting these variables in an inner execution is done here rather than through message arguments. "
ctx
geometry: geometry;
tentativeDistanceDict: tentativeDistanceDict;
unvisitedSet: unvisitedSet;
destination: destination.
self triggerInteractionFrom: #CURRENTINTERSECTION with: #computeDistanceToNeighbors.
instanceMethods: role binding
CONTEXT
^self
CURRENTINTERSECTION
" The undecided node that is closest to the origin. ('u' in the Dijkstra algorithm). "
| currDist |
current := nil.
currDist := Float infinity.
unvisitedSet do:
[:nod || dist |
(dist := (tentativeDistanceDict at: nod) distance) < currDist
ifTrue:
[current := nod.
currDist := dist]].
^current
DISTANCEDICT
" DistanceDict is a Dictionary with entries
(thisNode -> aTentativeDistance from the start node to thisNode) "
^tentativeDistanceDict
EASTNEIGHBOR
^geometry eastNeighborOf: (self at: #CURRENTINTERSECTION).
MAP
^geometry
SOUTHNEIGHBOR
^geometry southNeighborOf: (self at: #CURRENTINTERSECTION).
UNVISITED
" The set of unvisited nodes. ('Q' in the Dijkstra algorithm)"
^unvisitedSet
Interaction: CalculateShortestPathCTX
roleMethods: CURRENTINTERSECTION
instanceMethods: role methods
computeDistanceToNeighbors
" This method computes the final distance for the node named CURRENTINTERSECTION. "
EASTNEIGHBOR ifNotNil:
[EASTNEIGHBOR recomputeTentativeDistance].
SOUTHNEIGHBOR ifNotNil:
[SOUTHNEIGHBOR recomputeTentativeDistance].
UNVISITED remove: self.
UNVISITED ifNotEmpty: [CONTEXT recur].
computeDistanceToNeighborsWithTrace
"DO NOT REMOVE "
" The computeDistanceToNeighbors method can be augmented with the trace commands shown here to document that all nodes are mapped to all three roles at the same time. "
" This method computes the final distance for the node named the CURRENTINTERSECTION. "
self traceRM: {
' START ' , self name.
'EASTNEIGHBOR = ' , EASTNEIGHBOR name.
' SOUTHNEIGHBOR = ' , SOUTHNEIGHBOR name}.
EASTNEIGHBOR ifNotNil:
[EASTNEIGHBOR recomputeTentativeDistance].
SOUTHNEIGHBOR ifNotNil:
[SOUTHNEIGHBOR recomputeTentativeDistance].
UNVISITED remove: self.
UNVISITED ifNotEmpty: [CONTEXT recur].
self traceRM: {' END '. self name.}.
distanceTo: aNode
^(MAP distanceDict) at: (Edge new from: self to: aNode)
roleMethods: SOUTHNEIGHBOR
instanceMethods: role methods
recomputeTentativeDistance
| oldTentDist newTentDist |
Transcript cr; show: {CURRENTINTERSECTION name. '->'. self name. ' ('. #SOUTHNEIGHBOR. ').'.}.
oldTentDist := (DISTANCEDICT at: self) distance.
newTentDist := (DISTANCEDICT at: CURRENTINTERSECTION) distance
+ (CURRENTINTERSECTION distanceTo: self).
newTentDist < oldTentDist
ifTrue:
[(DISTANCEDICT at: self) distance: newTentDist previousNode: CURRENTINTERSECTION].
roleMethods: EASTNEIGHBOR
instanceMethods: role methods
recomputeTentativeDistance
| oldTentDist newTentDist |
Transcript cr; show: {CURRENTINTERSECTION name. '->'. self name. ' ('. #EASTNEIGHBOR. ').'.}.
oldTentDist := (DISTANCEDICT at: self) distance.
newTentDist := (DISTANCEDICT at: CURRENTINTERSECTION) distance
+ (CURRENTINTERSECTION distanceTo: self).
newTentDist < oldTentDist
ifTrue:
[(DISTANCEDICT at: self) distance: newTentDist previousNode: CURRENTINTERSECTION].
projection: Data
Class: CalculateShortestDistance
Object subclass: #CalculateShortestDistance
instanceVariableNames: 'geometry'
category: 'Dijkstra-Data'
instanceMethods: operations
shortestDistanceFrom: startName to: endName
| path |
path := (CalculateShortestPathCTX new geometry: geometry)
shortestPathFrom: startName to: endName.
^path last value
instanceMethods: attributes-write
geometry: geom
geometry := geom
Class: Edge
Object subclass: #Edge
instanceVariableNames: 'from to'
category: 'Dijkstra-Data'
" An instance represents an edge in the geometry network. (alternatively, it could be seen as representing a one way street going from an intersection to a neighboring intersection) "
instanceMethods: attributes-read
from
^ from
to
^ to
instanceMethods: attributes-write
from: f to: t
from := f.
to := t.
instanceMethods: operations
= anEdge
^from = anEdge from and: [to = anEdge to]
printOn: strm
" Convenience method used by Inspector and Debugger. "
super printOn: strm.
strm nextPutAll: ' ' , from name , '->' , to name.
instanceMethods: private
hash
^from hash bitXor: to hash
Class: ManhattanGeometry
Object subclass: #ManhattanGeometry
instanceVariableNames: 'nodeDict distanceDict eastNeighborDict southNeighborDict'
category: 'Dijkstra-Data'
" An instance represents a modified manhattan geometry.
The modification is that all edges are unidirectional and that all travel is eastwards and/or southwards.
"
instanceMethods: attributes-read
name
^self class name
nodes
^nodeDict values
nodeNamed: nodeName
^nodeDict at: nodeName
distanceDict
^distanceDict
eastNeighborOf: node
^eastNeighborDict at: node ifAbsent: [nil].
southNeighborOf: node
^southNeighborDict at: node ifAbsent: [nil].
instanceMethods: operations
addDistanceFrom: fromName to: toName as: distance
| fromNode toNode |
fromNode := nodeDict at: fromName.
toNode := nodeDict at: toName.
distanceDict
at: (Edge new from: fromNode to: toNode) put: distance.
addEastNeighborFrom: fromName to: toName
| fromNode toNode |
fromNode := nodeDict at: fromName.
toNode := nodeDict at: toName.
eastNeighborDict
at: fromNode put: toNode.
addSouthNeighborFrom: fromName to: toName
| fromNode toNode |
fromNode := nodeDict at: fromName.
toNode := nodeDict at: toName.
southNeighborDict
at: fromNode put: toNode.
Class: Node
Object subclass: #Node
instanceVariableNames: 'name'
category: 'Dijkstra-Data'
" An instance represents a named intersection in a modified manhattan geometry.
(See comments for the bManhattanGeometry class.
"
instanceMethods: initialize-release
initialize: aName
name := aName.
instanceMethods: attributes-read
name
^name
instanceMethods: operations
printOn: aStrm
" Convenience method used by Inspector and Debugger. "
super printOn: aStrm.
aStrm nextPutAll: '; node=' , name printString , String cr.
^aStrm
classMethods: instance creation
named: nameSymbol
^self basicNew initialize: nameSymbol
Class: TentativeDistance
Object subclass: #TentativeDistance
instanceVariableNames: 'distance previousNode thisNode thisRoleName'
category: 'Dijkstra-Data'
" Instance variables
# distance: a (tentative) distance from the origin node
# previousNode: the back node that lead to the above distance. "
instanceMethods: attributes-read
previousNode
"Answer the value of previousNode"
^ previousNode
distance
"Answer the value of distance"
^ distance
instanceMethods: attributes-write
distance: dist previousNode: prev
distance := dist.
previousNode := prev.
thisNode: aNode thisRoleName: aRoleName
(thisNode isNil or: [thisNode == aNode and: [thisRoleName = aRoleName]])
ifFalse: [self halt: aRoleName].
thisNode := aNode.
thisRoleName := aRoleName
instanceMethods: operations
printOn: aStrm
" A utility method used by inspector and debugger. "
super printOn: aStrm.
aStrm nextPutAll: '=' , self distance printString , ' prev=' , self previousNode name.
projection: Test
Class: ManhattanTest1
ManhattanGeometry subclass: #ManhattanTest1
instanceVariableNames: ''
category: 'Dijkstra-Test'
" Populate a ManhattanGeometry with test data. "
instanceMethods: initialize-release
initialize
super initialize.
self
initializeNodeDict;
initializeDistanceDict;
initializeEastNeighborsDict;
initializeSouthNeighborDict.
initializeDistanceDict
" Create the distance dictionary. "
distanceDict := Dictionary new.
nodeDict keys do: [:from| nodeDict keys do: [:to | self addDistanceFrom: from to: to as: Float infinity]].
" This indirect form is chosen to give user maximum readability. It's his responsibility to get it right! "
self
addDistanceFrom: #a to: #b as: 2;
addDistanceFrom: #b to: #c as: 3;
addDistanceFrom: #a to: #d as: 1;
addDistanceFrom: #b to: #e as: 2;
addDistanceFrom: #c to: #f as: 1;
addDistanceFrom: #d to: #e as: 1;
addDistanceFrom: #e to: #f as: 1;
addDistanceFrom: #d to: #g as: 2;
addDistanceFrom: #f to: #i as: 4;
addDistanceFrom: #g to: #h as: 1;
addDistanceFrom: #h to: #i as: 2.
initializeEastNeighborsDict
eastNeighborDict := Dictionary new.
self
addEastNeighborFrom: #a to: #b;
addEastNeighborFrom: #b to: #c;
addEastNeighborFrom: #d to: #e;
addEastNeighborFrom: #e to: #f;
addEastNeighborFrom: #g to: #h;
addEastNeighborFrom: #h to: #i.
initializeNodeDict
" Create the nodes. "
nodeDict := Dictionary new.
#(a b c d e f g h i) do:
[:nameSymbol | nodeDict at: nameSymbol put: (Node named: nameSymbol)].
initializeSouthNeighborDict
southNeighborDict := Dictionary new.
self
addSouthNeighborFrom: #a to: #d;
addSouthNeighborFrom: #b to: #e;
addSouthNeighborFrom: #c to: #f;
addSouthNeighborFrom: #d to: #g;
addSouthNeighborFrom: #f to: #i.
Class: ManhattanTest2
ManhattanGeometry subclass: #ManhattanTest2
instanceVariableNames: ''
category: 'Dijkstra-Test'
" Populate a ManhattanGeometry with test data. "
instanceMethods: initialize-release
initialize
super initialize.
self
initializeNodeDict;
initializeDistanceDict;
initializeEastNeighborsDict;
initializeSouthNeighborDict.
initializeDistanceDict
" Create the distance dictionary. "
distanceDict := Dictionary new.
nodeDict keys do: [:from| nodeDict keys do: [:to | self addDistanceFrom: from to: to as: Float infinity]].
" This indirect form is chosen to give user maximum readability. It's his responsibility to get it right! "
self
addDistanceFrom: #a to: #b as: 2;
addDistanceFrom: #b to: #c as: 3;
addDistanceFrom: #c to: #f as: 1;
addDistanceFrom: #f to: #i as: 4;
addDistanceFrom: #b to: #e as: 2;
addDistanceFrom: #e to: #f as: 1;
addDistanceFrom: #a to: #d as: 1;
addDistanceFrom: #d to: #g as: 2;
addDistanceFrom: #g to: #h as: 1;
addDistanceFrom: #h to: #i as: 2;
addDistanceFrom: #d to: #e as: 1;
addDistanceFrom: #c to: #j as: 1;
addDistanceFrom: #j to: #k as: 1;
addDistanceFrom: #i to: #k as: 2.
initializeEastNeighborsDict
eastNeighborDict := Dictionary new.
self
addEastNeighborFrom: #a to: #b;
addEastNeighborFrom: #b to: #c;
addEastNeighborFrom: #c to: #j;
addEastNeighborFrom: #d to: #e;
addEastNeighborFrom: #e to: #f;
addEastNeighborFrom: #g to: #h;
addEastNeighborFrom: #h to: #i;
addEastNeighborFrom: #i to: #k.
initializeNodeDict
" Create the nodes. "
| names |
nodeDict := Dictionary new.
names := #(a b c d e f g h i j k).
names do:
[:nameSymbol | nodeDict at: nameSymbol put: (Node named: nameSymbol)].
initializeSouthNeighborDict
southNeighborDict := Dictionary new.
self
addSouthNeighborFrom: #a to: #d;
addSouthNeighborFrom: #b to: #e;
addSouthNeighborFrom: #c to: #f;
addSouthNeighborFrom: #d to: #g;
addSouthNeighborFrom: #f to: #i;
addSouthNeighborFrom: #j to: #k.
Class: Test
Object subclass: #Test
instanceVariableNames: 'bank'
category: 'Dijkstra-Test'
" This class creates two test geometries and list distance and path from origin node to end node for each of them according to a modified Dijkstra algorithm.
More details in the respective Context class comments. "
instanceMethods: operations
run
| geometry1 geometry2 distance1 distance2 path1 path2 |
Transcript clear.
geometry1 := ManhattanTest1 new.
distance1 := (CalculateShortestDistance new geometry: geometry1) shortestDistanceFrom: #a to: #i.
Transcript cr; show:
'Shortest distance from ' , '#a' , ' to ' , '#i' , ' in ' , geometry1 name , ' is: ' , distance1 printString; cr.
path1 := (CalculateShortestPathCTX new geometry: geometry1) shortestPathFrom: #a to: #i.
Transcript cr; print: 'Shortest path from ' , '#a' , ' to ' , '#i' , ' in ' , geometry1 name , ' is: '; cr; tab.
path1 do: [:assoc | " node -> distance " Transcript space; print: assoc key name].
Transcript cr.
Transcript cr; show: '----------------------------------------'; cr.
geometry2 := ManhattanTest2 new.
distance2 := (CalculateShortestDistance new geometry: geometry2) shortestDistanceFrom: #a to: #k.
Transcript cr; show:
'Shortest distance from ' , '#a' , ' to ' , '#k' , ' in ' , geometry2 name , ' is: ' , distance2 printString; cr.
path2 := (CalculateShortestPathCTX new geometry: geometry2) shortestPathFrom: #a to: #k.
Transcript cr; show: 'Shortest path from ' , '#a' , ' to ' , '#k' , ' in ' , geometry2 name printString , ' is: '; cr; tab.
path2 do: [:assoc | " node -> distance " Transcript space; print: assoc key name].
Transcript cr.
Transcript cr; endEntry.
self assert:
[distance1 = 6 &
(path1 collect: [:assoc | assoc key name]) asArray = #(#a #d #g #h #i) &
distance2 = 7 &
(path2 collect: [:assoc | assoc key name]) asArray = #(#a #b #c #j #k)
].
self inform: 'Test Dijkstra OK.' , String cr , 'More details in Transcript.'.
classMethods: instance creation
run
self basicNew initialize run