
<<RouteDiGraphImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<Last Edited by: Preas, July 17, 1985 11:44:46 am PDT>>
<<>>
<<run IOConvertImpl ListImpl RopeImpl TerminalIOPackage RouteDiGraphImpl>>
<<>>
DIRECTORY 
Convert,
List,
Rope,
RouteDiGraph,
TerminalIO;

RouteDiGraphImpl: CEDAR PROGRAM
IMPORTS Convert, List, Rope, RouteDiGraph, TerminalIO
EXPORTS RouteDiGraph = {
<<Common Types>>
<<types>>
<<Errors>>
    Error: PUBLIC SIGNAL [errorType: RouteDiGraph.ErrorType _ callingError, explanation: Rope.ROPE _ NIL] = CODE; 
<<Graph>>

    CreateGraph: PUBLIC PROC [graphInfo: REF ANY _ NIL] RETURNS [graph: RouteDiGraph.Graph] = {
        <<Create a directed Graph.>>
        <<>>
        graph _ NEW[RouteDiGraph.GraphRec _ [graphInfo: graphInfo]];
        };

    DestroyGraph: PUBLIC PROC [graph: RouteDiGraph.Graph, enumGraph: RouteDiGraph.EnumGraphProc, enumNode: RouteDiGraph.EnumNodeProc, 
    enumArc: RouteDiGraph.EnumArcProc] = {
        <<There may be circular references. enumGraph, enumNode and enumArc allow client to NIL any circular references in graphInfo, 
        nodeInfo and arcInfo if necessary>>

        UnlinkNode: RouteDiGraph.EnumNodeProc =

            {DeleteArcs: RouteDiGraph.EnumArcsFromNodeProc =
                {RemoveArc[graph, arc]};

            graph.nodeList _ List.Remove[node, graph.nodeList];
            [] _ RouteDiGraph.EnumArcsFromNode[graph, node, both, DeleteArcs];
            };


        <<first do the client data>>
        IF enumNode # NIL THEN [] _ EnumNodes[graph, enumNode];
        IF enumArc # NIL THEN [] _ EnumArcs[graph, enumArc];
        IF enumGraph # NIL THEN [] _ enumGraph[graph];

        <<next unlink the arcs from the nodes>>
        [] _ EnumNodes[graph, UnlinkNode];
        };
<<Nodes>>
    CreateNode: PUBLIC PROC [nodeInfo: REF ANY _ NIL, superiorArcs, inferiorArcs: RouteDiGraph.ArcList _ NIL] RETURNS [node: 
    RouteDiGraph.Node] = {
        node _ NEW[RouteDiGraph.NodeRec _ [nodeInfo: nodeInfo, superiorArcs: superiorArcs, inferiorArcs: inferiorArcs]];
        };
        <<>>

    RemoveNode: PUBLIC PROC [graph: RouteDiGraph.Graph, node: RouteDiGraph.Node] RETURNS [removedArcs: RouteDiGraph.ArcList] = {

        DeleteArcs: RouteDiGraph.EnumArcsFromNodeProc =
            {RemoveArc[graph, arc]};

        IF graph # NIL THEN
            {graph.nodeList _ List.Remove[node, graph.nodeList];
            removedArcs _ List.Append[node.superiorArcs, node.inferiorArcs];
            [] _ RouteDiGraph.EnumArcsFromNode[graph, node, both, DeleteArcs]};
        };

    IncludeNode: PUBLIC PROC [graph: RouteDiGraph.Graph, node: RouteDiGraph.Node] = {
        AddArcs: RouteDiGraph.EnumArcsFromNodeProc =
            {IncludeArc[graph, arc]; RETURN[FALSE]};

        IF graph # NIL THEN
            {graph.nodeList _ List.Union[graph.nodeList, LIST[node]];
            [] _ RouteDiGraph.EnumArcsFromNode[graph, node, both, AddArcs]};
        };

    AddNewNode: PUBLIC PROC [graph: RouteDiGraph.Graph, nodeInfo: REF ANY _ NIL, superiorArcs, inferiorArcs: RouteDiGraph.ArcList _ 
    NIL] RETURNS [node: RouteDiGraph.Node] = {
        IF graph # NIL THEN
            {node _ RouteDiGraph.CreateNode[nodeInfo, superiorArcs, inferiorArcs];
            RouteDiGraph.IncludeNode[graph, node]};
        };
<<Arcs>>

    CreateArc: PUBLIC PROC [arcInfo: REF ANY _ NIL, superiorNode, inferiorNode: RouteDiGraph.Node, weight: REF ANY _ NIL] RETURNS [arc: 
    RouteDiGraph.Arc] = {
        arc _ NEW[RouteDiGraph.ArcRec _ [arcInfo: arcInfo, superiorNode: superiorNode, inferiorNode: inferiorNode, weight: weight]];
        };

    RemoveArc: PUBLIC PROC [graph: RouteDiGraph.Graph, arc: RouteDiGraph.Arc] = {
        IF graph # NIL AND arc # NIL THEN
            {sNode: RouteDiGraph.Node _ arc.superiorNode;
            iNode: RouteDiGraph.Node _ arc.inferiorNode;
            sNode.inferiorArcs _ List.Remove[arc, sNode.inferiorArcs];
            iNode.superiorArcs _ List.Remove[arc, iNode.superiorArcs];
            graph.arcList _ List.Remove[arc, graph.arcList]};
        };

    IncludeArc: PUBLIC PROC [graph: RouteDiGraph.Graph, arc: RouteDiGraph.Arc] = {
        IF graph # NIL AND arc # NIL THEN
            {sNode: RouteDiGraph.Node _ arc.superiorNode;
            iNode: RouteDiGraph.Node _ arc.inferiorNode;
            sNode.inferiorArcs _ List.Union[sNode.inferiorArcs, LIST[arc]];
            iNode.superiorArcs _ List.Union[iNode.superiorArcs, LIST[arc]];
            <<need to include only if not already in the list>>
            graph.arcList _ List.Union[graph.arcList, LIST[arc]]};
        };

    IncludeArcs: PUBLIC PROC [graph: RouteDiGraph.Graph, arcs: RouteDiGraph.ArcList] ~ {
        IF graph # NIL THEN
            FOR aList: RouteDiGraph.NodeList _ arcs, aList.rest WHILE aList # NIL DO
                arc: RouteDiGraph.Arc _ NARROW[aList.first];
                IncludeArc[graph, arc];
                ENDLOOP;
        };

    AddNewArc: PUBLIC PROC [graph: RouteDiGraph.Graph, arcInfo: REF ANY _ NIL, superiorNode, inferiorNode: RouteDiGraph.Node, weight: 
    REF ANY _ NIL] RETURNS [arc: RouteDiGraph.Arc] = {
        arc _ RouteDiGraph.CreateArc[arcInfo, superiorNode, inferiorNode, weight];
        RouteDiGraph.IncludeArc[graph, arc];
        };
<<Predicates>>

    InCycle: PUBLIC PROC [graph: RouteDiGraph.Graph, node: RouteDiGraph.Node] RETURNS [BOOLEAN] = {
        RETURN[TRUE]
        };

    OnLongestPath: PUBLIC PROC [graph: RouteDiGraph.Graph, node: RouteDiGraph.Node] RETURNS [BOOLEAN] = {
        RETURN[TRUE]
        };

    PathExists: PUBLIC PROC [graph: RouteDiGraph.Graph, upperNode, lowerNode: RouteDiGraph.Node]RETURNS [quit: BOOLEAN _ FALSE] = {

        <<recursively go through the constraints>>
        ArcProc: RouteDiGraph.EnumArcsFromNodeProc = {
            IF arc.inferiorNode = lowerNode THEN quit _ TRUE
            ELSE {
                IF ~List.Memb[arc.inferiorNode, visitedNodes] THEN {
                    visitedNodes _ CONS[arc.inferiorNode, visitedNodes];
                    quit _ RouteDiGraph.EnumArcsFromNode[graph, arc.inferiorNode, in, ArcProc]}}};

        visitedNodes: RouteDiGraph.ArcList _ NIL;
        quit _ RouteDiGraph.EnumArcsFromNode[graph, upperNode, in, ArcProc]};
<<Graph Operations>>

    EnumNodesInTopoOrder: PUBLIC PROC [graph: RouteDiGraph.Graph, enumNode: RouteDiGraph.EnumNodeProc] RETURNS [quit: BOOLEAN _ FALSE] 
    = {
        ResetParity: RouteDiGraph.EnumNodeProc ~ {
            node.superiorParity _ List.Length[node.superiorArcs];
            node.inferiorParity _ List.Length[node.inferiorArcs]};

        <<recursively go through the constraints>>
        ArcProc: RouteDiGraph.EnumArcsFromNodeProc = {
            superiorNode: RouteDiGraph.Node _ arc.superiorNode;
            superiorNode.inferiorParity _ superiorNode.inferiorParity - 1;
            IF superiorNode.inferiorParity = 0 THEN {
                quit _ enumNode[graph, superiorNode];
                IF ~quit THEN 
                    quit _ RouteDiGraph.EnumArcsFromNode[graph, superiorNode, out, ArcProc]}};

        NodeProc: RouteDiGraph.EnumNodeProc = {
            IF node.inferiorParity = 0 THEN {
                quit _ enumNode[graph, node];
                IF ~quit THEN 
                    quit _ RouteDiGraph.EnumArcsFromNode[graph, node, out, ArcProc]}};

        [] _ RouteDiGraph.EnumNodes[graph, ResetParity];
        quit _ RouteDiGraph.EnumNodes[graph, NodeProc];
        };

    EnumNodes: PUBLIC PROC [graph: RouteDiGraph.Graph, enumNode: RouteDiGraph.EnumNodeProc] RETURNS [quit: BOOLEAN _ FALSE] = {
        IF graph # NIL THEN
            FOR nList: RouteDiGraph.NodeList _ graph.nodeList, nList.rest WHILE ~quit AND nList # NIL DO
                quit _ enumNode[graph, NARROW[nList.first]];
                ENDLOOP;
        };

    EnumArcs: PUBLIC PROC [graph: RouteDiGraph.Graph, enumArc: RouteDiGraph.EnumArcProc] RETURNS [quit: BOOLEAN  _ FALSE] = {
        IF graph # NIL THEN
            FOR aList: RouteDiGraph.ArcList _ graph.arcList, aList.rest WHILE ~quit AND aList # NIL DO
                quit _ enumArc[graph, NARROW[aList.first]];
                ENDLOOP;
        };

    EnumArcsFromNode: PUBLIC PROC [graph: RouteDiGraph.Graph, node: RouteDiGraph.Node, direction: RouteDiGraph.DirectionOrBoth, 
    enumArc: RouteDiGraph.EnumArcsFromNodeProc] RETURNS [quit: BOOLEAN _ FALSE] = {
        IF node # NIL AND graph # NIL THEN
            {IF direction = in OR direction = both THEN
                FOR aList: RouteDiGraph.ArcList _ node.inferiorArcs, aList.rest WHILE ~quit AND aList # NIL DO
                    quit _ enumArc[graph, NARROW[aList.first], node, in];
                    ENDLOOP;
            IF direction = out OR direction = both THEN
                FOR aList: RouteDiGraph.ArcList _ node.superiorArcs, aList.rest WHILE ~quit AND aList # NIL DO
                    quit _ enumArc[graph, NARROW[aList.first], node, out];
                    ENDLOOP;
            };
        };
<<Utility Operations>>
    CheckGraph: PUBLIC PROC [graph: RouteDiGraph.Graph] RETURNS [ok: BOOLEAN] = {
        };

    WriteNodes: PUBLIC PROC [graph: RouteDiGraph.Graph, writeNode: RouteDiGraph.EnumNodeProc, writeArc: 
    RouteDiGraph.EnumArcsFromNodeProc] = {
        ListNode: RouteDiGraph.EnumNodeProc =
            {quit _ writeNode[graph, node];

            IF ~quit THEN
                {TerminalIO.PutRope[Rope.Cat["\n", "          superior arcs: "]];
                quit _ EnumArcsFromNode[graph, node, out, writeArc]};

            IF ~quit THEN
                {TerminalIO.PutRope[Rope.Cat["\n", "          inferior arcs: "]];
                quit _ EnumArcsFromNode[graph, node, in, writeArc]};
            };

        TerminalIO.PutRope[Rope.Cat["\n", "graph: ", SimpleRefAny[graph.graphInfo]]];
        TerminalIO.PutRope["\n nodes: "];
        [] _ EnumNodes[graph, ListNode];
        };

    SimpleListNodeProc: PUBLIC RouteDiGraph.EnumNodeProc = {
        TerminalIO.PutRope[Rope.Cat["\n", "     name: ", SimpleRefAny[node.nodeInfo]]];
        RETURN[FALSE];
        };

    SimpleListArcNodeProc: PUBLIC RouteDiGraph.EnumArcsFromNodeProc =

        {
        TerminalIO.PutRope[Rope.Cat["\n", "               name: ", SimpleRefAny[arc.arcInfo], ", weight: ", SimpleRefAny[arc.weight]]];
        RETURN[FALSE];
        };


    WriteArcs: PUBLIC PROC [graph: RouteDiGraph.Graph, writeArc: RouteDiGraph.EnumArcProc, writeNode: RouteDiGraph.EnumNodeProc] = {
        ListArc: RouteDiGraph.EnumArcProc =
            {quit _ writeArc[graph, arc];

            IF ~quit THEN
                {TerminalIO.PutRope[Rope.Cat["\n", "          superior node: "]];
                quit _ writeNode[graph, arc.superiorNode]};

            IF ~quit THEN
                {TerminalIO.PutRope[Rope.Cat["\n", "          inferior node: "]];
                quit _ writeNode[graph, arc.inferiorNode]};
            };

        TerminalIO.PutRope[Rope.Cat["\n", "graph: ", SimpleRefAny[graph.graphInfo]]];
        TerminalIO.PutRope["\n arcs: "];
        [] _ EnumArcs[graph, ListArc];
        };

    SimpleListArcProc: PUBLIC RouteDiGraph.EnumArcProc = {
        TerminalIO.PutRope[Rope.Cat["\n", "    name: ", SimpleRefAny[arc.arcInfo], ", weight: ", SimpleRefAny[arc.weight]]];
        RETURN[FALSE];
        };

    SimpleRefAny: PUBLIC PROC [in: REF ANY] RETURNS [out: Rope.ROPE _ NIL] = {
        IF in # NIL THEN
            WITH in SELECT FROM
                rr: REF Rope.ROPE => out _ rr^;
                r: Rope.ROPE => out _ r;
                ri: REF INT => out _ Convert.RopeFromInt[ri^];
                rre: REF REAL => out _ Convert.RopeFromReal[rre^];
                ENDCASE => Error [callingError, "Invalid Ref Any type."];
        RETURN[out];
        };
}.