,

DCIprogram: #Dijkstra

" Exported from Squeak 7179-basic.226 last modified on 3 November 2014 by: Trygve"

Reader friendly version

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

No diagram

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