DIRECTORY FIFOQueue, PropertyLists, Random, Graphs0, Graphs0Path; Graphs0PathImpl: CEDAR PROGRAM IMPORTS FIFOQueue, PropertyLists, Random, Graphs0 EXPORTS Graphs0Path = BEGIN OPEN Graphs0Path; Graph: TYPE = Graphs0.Graph; Node: TYPE = Graphs0.Node; NodeList: TYPE = Graphs0.NodeList; Arc: TYPE = Graphs0.Arc; ArcList: TYPE = Graphs0.ArcList; EnumArcProc: TYPE = Graphs0.EnumArcProc; NotPossible: PUBLIC ERROR = CODE; NodeListRemove: PROC [nodeList: NodeList, node: Node] RETURNS [NodeList_NIL] = { IF nodeList=NIL THEN RETURN [NIL]; IF nodeList.first=node THEN RETURN [nodeList.rest] ELSE { FOR list: NodeList _ nodeList, list.rest WHILE list.rest#NIL DO IF list.rest.first=node THEN {list.rest _ list.rest.rest; EXIT}; ENDLOOP; RETURN [nodeList] } }; KillProperties: PROC [graph: Graph, key: REF] = { EachNode: Graphs0.EnumNodeProc = { node.props _ PropertyLists.PutProp[node.props, key, NIL]; FOR list: ArcList _ node.arcs, list.rest WHILE list#NIL DO list.first.props _ PropertyLists.PutProp[list.first.props, key, NIL]; ENDLOOP; }; [] _ Graphs0.EnumNodes[graph, EachNode, key]; graph.props _ PropertyLists.PutProp[graph.props, key, NIL]; }; OtherNode: PROC [arc: Arc, node: Node] RETURNS [Node] = INLINE { IF arc.node1=node THEN RETURN [arc.node2] ELSE IF arc.node2=node THEN RETURN [arc.node1] ELSE ERROR }; PerNode: TYPE = REF PerNodeRec; PerNodeRec: TYPE = RECORD [ cost: INT _ infinite, --current best cost cameArc: Arc _ NIL, --current arc expansion came from connected: BOOL _ FALSE, --node is connected (low impedance!) to the previosly treated nodes goal: BOOL _ FALSE, --this node must be, but is not yet be connected (don't care about high impedance) inQueue: BOOL _ FALSE, --whether this node is queue to be visited aequiv: NodeList _ NIL --node set of internaly (high impedance!) connected nodes ]; Get: PROC [node: Node, myKey: REF] RETURNS [perNode: PerNode] = { WITH PropertyLists.GetProp[node.props, myKey] SELECT FROM pn: PerNode => perNode _ pn; ENDCASE => { perNode _ NEW[PerNodeRec]; node.props _ PropertyLists.PutProp[node.props, myKey, perNode] }; }; FindPath: PUBLIC PROC [graph: Graph, nodeSets: NodeSetList, arcCostProc: ArcCostProc, arcDeliverProc: EnumArcProc, data: REF_NIL, effort: NAT _ 1, random: BOOL_FALSE] RETURNS [quit: BOOL_FALSE] = { myKey: REF ATOM _ NEW[ATOM_$Graphs0PathImpl]; queue: FIFOQueue.Queue ~ FIFOQueue.Create[]; SetConnected: PROC [node: Node, cheat: BOOL_FALSE] = { ConnectOne: PROC [node: Node, strong: BOOL_FALSE] = { pn: PerNode ~ Get[node, myKey]; pn.goal _ FALSE; toTreat _ NodeListRemove[toTreat, node]; IF strong THEN pn.connected _ TRUE; }; pn: PerNode ~ Get[node, myKey]; ConnectOne[node, TRUE]; FOR nl: NodeList _ pn.aequiv, nl.rest WHILE nl#NIL DO ConnectOne[nl.first, cheat]; ENDLOOP; }; FixCheatedNode: PROC [startNode: Node] = { FOR nl: NodeList _ Get[startNode, myKey].aequiv, nl.rest WHILE nl#NIL DO IF nl.first#startNode THEN { pn: PerNode ~ Get[nl.first, myKey]; pn.connected _ FALSE; pn.goal _ FALSE; } ENDLOOP; }; Reset: PROC [queue: FIFOQueue.Queue, myKey: REF] = { ResetNode: Graphs0.EnumNodeProc = { pn: PerNode ~ Get[node, data]; IF (pn.inQueue _ pn.connected) THEN { FIFOQueue.Include[queue, node]; pn.cost _ 0; } ELSE pn.cost _ infinite; }; FIFOQueue.Flush[queue]; [] _ Graphs0.EnumNodes[graph, ResetNode, myKey]; }; SpreadOut: PROC [queue: FIFOQueue.Queue, myKey: REF, random: BOOL] RETURNS [found: Node _ NIL] = { fromNode, toNode: Node; fromPn, toPn: PerNode; maximumCost: INT _ LAST[INT]; DO fromNode _ NARROW[FIFOQueue.Remove[queue ! FIFOQueue.Empty => GOTO finish]]; fromPn _ Get[fromNode, myKey]; fromPn.inQueue _ FALSE; IF fromPn.cost>=maximumCost THEN LOOP; FOR l: ArcList _ fromNode.arcs, l.rest WHILE l#NIL DO arc: Arc ~ l.first; cost: INT ~ arcCostProc[arc, graph, data]; IF cost#infinite THEN { toNode _ OtherNode[arc, fromNode]; toPn _ Get[toNode, myKey]; IF fromPn.cost+costtoPn.cost THEN { fromPn.cost _ MIN[fromPn.cost, toPn.cost+cost+1]; EXIT --the inner FOR loop } ELSE IF random AND fromPn.cost+cost=toPn.cost THEN { IF Random.ChooseInt[NIL, 0, 1]=0 THEN toPn.cameArc _ arc } }; ENDLOOP; ENDLOOP; EXITS finish => NULL; }; GoBackFrom: PROC [node: Node] = { pn: PerNode _ Get[node, myKey]; WHILE ~pn.connected AND ~quit DO SetConnected[node]; IF pn.cameArc=NIL THEN ERROR; --impossible quit _ arcDeliverProc[graph, pn.cameArc, data]; node _ OtherNode[pn.cameArc, node]; pn _ Get[node, myKey]; ENDLOOP }; SetUpInput: PROC [nodeSets: NodeSetList] RETURNS [nodes: NodeList_NIL, startNode: Node_NIL] = { FOR list: NodeSetList _ nodeSets, list.rest WHILE list #NIL DO nl: NodeList _ list.first; IF nl.rest=NIL THEN startNode _ nl.first; FOR l: NodeList _ nl, l.rest WHILE l#NIL DO pn: PerNode ~ Get[l.first, myKey]; IF pn.goal THEN ERROR; --node is included twice in list FOR al: ArcList _ l.first.arcs, al.rest WHILE al#NIL DO IF al.first.node1=al.first.node2 THEN ERROR --circular arcs not allowed ENDLOOP; pn.goal _ TRUE; pn.aequiv _ nl; nodes _ CONS[l.first, nodes] ENDLOOP; ENDLOOP; IF nodeSets=NIL OR nodeSets.rest=NIL THEN ERROR; --need two or more nodeSets to connect IF nodes=NIL OR nodes.rest=NIL THEN ERROR; --need two or more nodes to connect }; foundNode, startNode: Node; toTreat: NodeList; cheatOnStart: BOOL _ FALSE; [toTreat, startNode] _ SetUpInput[nodeSets]; IF startNode=NIL THEN {cheatOnStart _ TRUE; startNode _ toTreat.first}; SetConnected[node: startNode, cheat: cheatOnStart]; WHILE toTreat#NIL AND ~quit DO Reset[queue, myKey]; foundNode _ SpreadOut[queue, myKey, random]; IF foundNode=NIL THEN ERROR NotPossible; --failed, e.g. nodes were not connected GoBackFrom[foundNode]; IF cheatOnStart THEN {cheatOnStart_FALSE; FixCheatedNode[startNode]}; ENDLOOP; KillProperties[graph, myKey]; }; END. Graphs0PathImpl.mesa Copyright c 1986 by Xerox Corporation. All rights reserved. Created by: Christian Jacobi, September 15, 1986 11:07:56 am PDT Last edited by: Christian Jacobi, September 30, 1986 1:57:52 pm PDT It would be better to use a priority queue instead of a FIFOQueue! -- +1 to make sure node will be handled again when toNode will be handled. -- toNode will be handled because it can't have been handled already. -- the cost decrease is to help prune searchtree between now and when toNode -- is handled. ΚO˜codešœ™Kšœ Οmœ1™˜>K˜——Kšœ˜—K˜šŸœžœžœdžœžœ žœžœžœžœžœžœ˜ΕKš œžœžœžœžœ˜-Kšœ.˜.K˜šŸ œžœžœžœ˜6šŸ œžœžœžœ˜5Kšœ˜Kšœ žœ*˜9Kšžœžœžœ˜#K˜—Kšœ˜Kšœžœ˜šžœ#žœžœž˜5Kšœ˜Kšžœ˜—Kšœ˜—K˜šŸœžœ˜*šžœ6žœžœž˜Hšžœžœ˜Kšœ#˜#Kšœžœ žœ˜'J˜—Kšžœ˜—J˜J˜—šŸœžœ!žœ˜4šŸ œ˜#Kšœ˜šžœžœ˜%Kšœ,˜,K˜—Kšžœ˜K˜—Kšœ˜Kšœ0˜0K˜—K˜š Ÿ œžœ!žœ žœžœžœ˜bKšœ/˜/Kšœ žœžœžœ˜šž˜Kšœ žœ-žœ ˜LKšœ0žœ˜6Kšžœžœžœ˜&šžœ$žœžœž˜5Kšœžœ!˜>šžœžœ˜Kšœ=˜=šžœžœ˜$Kšœ1˜1šžœžœžœ˜1šžœ žœ˜Kšžœžœ*˜GK˜—Kšžœžœ#˜Kšœ˜Kšžœ žœžœ˜)šžœžœžœž˜+Kšœ"˜"Kšžœ žœžœ !˜8šžœ%žœžœž˜7Kšžœžœžœ ˜GKšž˜—Kšœ žœ˜Kšœ˜Kšœžœ˜Kšžœ˜—Kšžœ˜—Kš žœ žœžœžœžœžœ &˜WKš žœžœžœ žœžœžœ #˜NKšœ˜K˜—Kšœ=žœžœ˜KKšœ,˜,Kšžœ žœžœžœ˜GKšœ3˜3šžœ žœžœž˜Kšœ˜Kšœ,˜,Kš žœ žœžœžœ '˜PKšœ˜Kšžœžœžœ˜EKšžœ˜ —Kšœ˜K˜—K˜Kšžœ˜K˜—…—€"