Graphs0PathImpl.mesa
Copyright © 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!
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+cost<toPn.cost
THEN {
toPn.cost ← fromPn.cost+cost; toPn.cameArc ← arc;
IF ~toPn.inQueue
AND toPn.cost<maximumCost
THEN {
IF toPn.goal
THEN {
IF toPn.cost<maximumCost THEN {maximumCost ← toPn.cost; found ← toNode}
}
ELSE {toPn.inQueue ← TRUE; FIFOQueue.Include[queue, toNode]}
}
}
ELSE
IF fromPn.cost-cost>toPn.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.