<> <> <> <> <<>> <<>> <> <<>> 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]; <<-- +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. >> 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.