MODULE GDGraph;

IMPORT Rd, Wr, Thread;
IMPORT FileFmt, FGet, NGet, FPut, NPut;
FROM Stdio IMPORT stderr;

TYPE
  Neighborhood = ARRAY Dir OF REF Nodes; (* The neighbors of a node. *)

REVEAL
  T = PublicT BRANDED OBJECT
      nb: REF ARRAY OF Neighborhood;
        (* 
          "nb[u][dir]^" are the neighbors of node "u" in direction "dir". *)
    OVERRIDES
      init := InitMethod;
      copy := CopyMethod;
      nbor := NborMethod;
      nbors := NborsMethod;
      addNode := AddNodeMethod;
      addEdge := AddEdgeMethod;
      deleteEdge := DeleteEdgeMethod;
      crunch := CrunchMethod;
      findSlot := FindSlotMethod;
      degree := DegreeMethod;
      degrees := DegreesMethod;
      edges := EdgesMethod;
    END;
    
<* FATAL Wr.Failure, Thread.Alerted *>

PROCEDURE InitMethod(G: T; allocNodes: NAT := 20): T =
  BEGIN
    G.nV := 0; 
    G.nE := 0;
    G.nb := NEW(REF ARRAY OF Neighborhood, allocNodes); 
    RETURN G
  END InitMethod;
  
PROCEDURE CopyMethod(G: T): T =
  BEGIN
    WITH
      nb = G.nb^,
      H = NEW(T).init(allocNodes := NUMBER(nb)),
      nbG = G.nb^,
      nbH = H.nb^
    DO
      FOR u := 0 TO G.nV - 1 DO
        FOR dir := -1 TO +1 DO
          nbH[u][dir] := NEW(REF Nodes, NUMBER(nbG[u][dir]^));
          nbH[u][dir]^ := nbG[u][dir]^;
        END;
      END;
      H.nV := G.nV; H.nE := G.nE;
      RETURN H
    END
  END CopyMethod;

PROCEDURE DegreeMethod(G: T; u: Node; dir: Dir; proper: BOOL): NAT =
  BEGIN
    IF NOT proper THEN
      RETURN NUMBER(G.nb[u][dir]^)
    ELSE
      RETURN CountProperNodes(G.nb[u][dir]^)
    END
  END DegreeMethod;

PROCEDURE DegreesMethod(G: T; u: Node; proper: BOOL): Degrees =
  VAR deg: Degrees;
  BEGIN
    FOR dir := -1 TO +1 DO
      IF NOT proper THEN
        deg[dir] := NUMBER(G.nb[u][dir]^)
      ELSE
        deg[dir] := CountProperNodes(G.nb[u][dir]^)
      END
    END;
    RETURN deg
  END DegreesMethod;
  
PROCEDURE NborMethod(G: T; u: Node; dir: Dir; k: Slot): Node =
  BEGIN
    RETURN G.nb[u][dir][k]
  END NborMethod;

PROCEDURE NborsMethod(G: T; u: Node; dir: Dir; proper: BOOL): REF Nodes =
  BEGIN
    <* ASSERT u # NoNode *>
    WITH vv = G.nb[u][dir]^ DO
      IF proper THEN 
        RETURN ProperNodes(vv)
      ELSE
        RETURN CopyNodes(vv)
      END
    END
  END NborsMethod;
  
PROCEDURE AddNodeMethod(G: T; deg: Degrees): Node =
  BEGIN
    WITH nV = G.nV, u = nV + 0 DO
      IF nV >= NUMBER(G.nb^) THEN 
        WITH sz = 2*nV DO 
          WITH nbNew = NEW(REF ARRAY OF Neighborhood, sz) DO 
            SUBARRAY(nbNew^,0,nV) := SUBARRAY(G.nb^,0,nV); G.nb := nbNew
          END
        END
      END;
      WITH nb = G.nb[u] DO
        FOR dir := -1 TO +1 DO
          WITH g = deg[dir], vvR = NEW(REF Nodes, g), vv = vvR^ DO
            nb[dir] := vvR;
            FOR k := 0 TO g-1 DO vv[k] := NoNode END
          END;
        END
      END;
      INC(G.nV);
      RETURN u
    END
  END AddNodeMethod;
  
PROCEDURE AddEdgeMethod(G: T; dir: Dir; u: Node; ku: Slot; v: Node; kv: Slot) =
  BEGIN
    <* ASSERT u # NoNode *>
    <* ASSERT v # NoNode *>
    IF dir = 0 THEN <* ASSERT u # v *> END;
    WITH slot = G.nb[u][dir][ku] DO
      <* ASSERT slot = NoNode *>
      slot := v
    END;
    WITH slot = G.nb[v][-dir][kv] DO
      <* ASSERT slot = NoNode *>
      slot := u
    END;
    INC(G.nE)
  END AddEdgeMethod;
  
PROCEDURE DeleteEdgeMethod(G: T; dir: Dir; u: Node; ku: Slot; v: Node; kv: Slot) =
  BEGIN
    <* ASSERT u # NoNode *>
    <* ASSERT v # NoNode *>
    IF dir = 0 THEN <* ASSERT u # v *> END;
    WITH slot = G.nb[u][dir][ku] DO
      <* ASSERT slot = v *>
      slot := NoNode
    END;
    WITH slot = G.nb[v][-dir][kv] DO
      <* ASSERT slot = u *>
      slot := NoNode
    END;
    DEC(G.nE)
  END DeleteEdgeMethod;
  
PROCEDURE FindSlotMethod(G: T; u: Node; dir: Dir; v: Node): Slot =
  BEGIN
    <* ASSERT u # NoNode *>
    <* ASSERT LAST(NAT) = LAST(Slot) *>
    RETURN FindNode(v, G.nb[u][dir]^)
  END FindSlotMethod;

PROCEDURE EdgesMethod(G: T; dir: Dir): REF Edges =
  VAR kE: NAT := 0;
  BEGIN
    WITH 
      nV = G.nV, nE = G.nE,
      x = G.nb^,
      eeR = NEW(REF Edges, nE), ee = eeR^
    DO
      FOR u := 0 TO nV-1 DO
        WITH vv = x[u][dir]^ DO
          FOR k := 0 TO LAST(vv) DO 
            WITH v = vv[k] DO
              IF v # NoNode THEN
                IF dir = 0 THEN <* ASSERT u # v *> END;
                IF dir # 0 OR v > u THEN ee[kE] := Edge{u,v}; INC(kE) END 
              END
            END
          END
        END
      END;
      <* ASSERT kE = nE *>
      RETURN eeR
    END
  END EdgesMethod;
  
PROCEDURE CrunchMethod(G: T; nKeep: NAT): NodeDict =
  VAR nP, mV, mE: NAT;
  BEGIN
    IF nKeep > G.nV THEN nKeep := G.nV END;
    (* Wr.PutText(stderr, "crunching from " & FI(G.nV) & ":" & FI(G.nE)); *)
    WITH
      oldR = NEW(REF Nodes, G.nV), old = oldR^,
      newR = NEW(REF Nodes, G.nV), new = newR^
    DO
      (* List of initial nodes: *)
      FOR u := 0 TO nKeep-1 DO old[u] := u; new[u] := u END;
      (* See if there is anything else to do: *)
      IF nKeep < G.nV THEN
        FOR u := nKeep TO G.nV-1 DO new[u] := NoNode; old[u] := NoNode END;
        (* Breadth-first scan, set "mV" to number of reachable nodes: *)
        nP := 0; mV := nKeep;
        WHILE nP < mV DO
          WITH u = old[nP], nbu = G.nb[u] DO 
            FOR dir := -1 TO +1 DO
              WITH vv = nbu[dir]^ DO
                FOR k := 0 TO LAST(vv) DO
                  WITH v = vv[k] DO 
                    IF v # NoNode AND new[v] = NoNode THEN
                      new[v] := mV; old[mV] := v; INC(mV)
                    END
                  END
                END
              END
            END
          END;
          INC(nP)
        END;
        (* Map neighbor lists to new numbers, count edges: *)
        mE := 0;
        WITH 
          nbR = NEW(REF ARRAY OF Neighborhood, (3*mV) DIV 2 + 20), nb = nbR^
        DO
          FOR uNew := 0 TO mV-1 DO
            WITH uOld = old[uNew] DO
              nb[uNew] := G.nb[uOld]; 
              G.nb[uOld] := Neighborhood{NIL,NIL,NIL};
              FOR dir := -1 TO +1 DO
                WITH vv = nb[uNew][dir]^ DO
                  FOR k := 0 TO LAST(vv) DO
                    WITH v = vv[k] DO 
                      IF v # NoNode THEN 
                        IF dir > 0 OR (dir = 0 AND uOld < v) THEN INC(mE) END;
                        v := new[v]; 
                        <* ASSERT v # NoNode *>
                      END
                    END
                  END
                END
              END;
            END
          END;
          G.nb := nbR;
        END;
        (* Update node and edge counts: *)
        G.nV := mV; G.nE := mE;
      END;
      (* Wr.PutText(stderr, " to " & FI(G.nV) & ":" & FI(G.nE) & "\n"); *)
      RETURN NodeDict{old := oldR, new := newR}
    END;
  END CrunchMethod;
  
(* UTILITY PROCEDURES *)

PROCEDURE CountProperNodes(READONLY uu: Nodes): NAT =
  VAR n: NAT := 0;
  BEGIN
    FOR i := 0 TO LAST(uu) DO IF uu[i] # NoNode THEN INC(n) END END;
    RETURN n
  END CountProperNodes;
  
PROCEDURE ProperNodes(READONLY uu: Nodes): REF Nodes =
  VAR k: NAT;
  BEGIN
    WITH n = CountProperNodes(uu),  wwR = NEW(REF Nodes, n), ww = wwR^ DO
      k := 0;
      FOR i := 0 TO LAST(uu) DO
        WITH u = uu[i] DO IF u # NoNode THEN ww[k] := u; INC(k) END END
      END;
      <* ASSERT k = n *>
      RETURN wwR
    END
  END ProperNodes;

PROCEDURE CopyNodes(READONLY uu: Nodes): REF Nodes =
  BEGIN
    WITH n = NUMBER(uu), wwR = NEW(REF Nodes, n), ww = wwR^ DO
      ww := uu;
      RETURN wwR
    END    
  END CopyNodes;

PROCEDURE FindNode(u: Node; READONLY vv: Nodes): Slot =
  BEGIN
    FOR i := 0 TO LAST(vv) DO 
      IF vv[i] = u THEN RETURN i END
    END;
    RETURN LAST(NAT)
  END FindNode;

PROCEDURE InsertNode(u: Node; VAR vvR: REF Nodes; VAR n: NAT) = 
  BEGIN
    IF vvR = NIL THEN
      vvR := NEW(REF Nodes, 10)
    ELSIF n >= NUMBER(vvR^) THEN
      WITH wwR = NEW(REF Nodes, 2*n+10) DO
        SUBARRAY(wwR^,0,n) := SUBARRAY(vvR^,0,n); vvR := wwR
      END
    END;
    vvR[n] := u; INC(n)
  END InsertNode;
  
PROCEDURE DeleteNode(u: Node; VAR vvR: REF Nodes; VAR n: NAT) = 
  VAR k: NAT := 0;
  BEGIN
    <* ASSERT vvR # NIL *>
    WITH vv = vvR^ DO
      WHILE k < n AND vv[k] # u DO INC(k) END;
      IF k < n THEN 
        vv[k] := vv[n-1]; DEC(n);
        IF 4*n + 20 < NUMBER(vv) THEN 
          (* Reallocate "vvR^": *)
          WITH wwR = NEW(REF Nodes, 2*n+10) DO
            SUBARRAY(wwR^,0,n) := SUBARRAY(vvR^,0,n); vvR := wwR
          END
        END
      END
    END
  END DeleteNode;

CONST GraphFileVersion = "2000-01-13";

PROCEDURE Read(rd: Rd.T; allocNodes: NAT := 0): T =
  VAR nV, nE, nS: NAT;
  
  PROCEDURE GetNode(): NAT =
    <* FATAL Rd.EndOfFile, Rd.Failure, Thread.Alerted *>
    BEGIN 
      IF FGet.Test(rd, '*') THEN 
        EVAL Rd.GetChar(rd); RETURN NoNode
      ELSE
        RETURN FGet.Int(rd)
      END
    END GetNode;
  
  PROCEDURE GetSlot(): NAT =
    BEGIN 
      FGet.Colon(rd); RETURN FGet.Int(rd)
    END GetSlot;
  
  PROCEDURE GetDir(): Dir =
    BEGIN
      WITH c = FGet.Char(rd) DO 
        IF c = '<' THEN
          RETURN -1
        ELSIF c = '>' THEN
          RETURN +1
        ELSIF c = '-' THEN 
          RETURN 00
        ELSE
          <* ASSERT FALSE *>
        END
      END;
    END GetDir;
  
  CONST BadNode = NoNode - 1;
  
  BEGIN 
    Wr.PutText(stderr, "(graph header...");
    FileFmt.ReadHeader(rd, "graph", GraphFileVersion);
    Wr.PutText(stderr, "comment...");
    EVAL FileFmt.ReadComment(rd, '|'); 
    Wr.PutText(stderr, "nodes...");
    nV := NGet.Int(rd, "nodes"); FGet.EOL(rd);
    Wr.PutText(stderr, "edges...");
    nE := NGet.Int(rd, "edges"); FGet.EOL(rd);
    Wr.PutText(stderr, "edges...");
    nS := NGet.Int(rd, "slots"); FGet.EOL(rd);
    Wr.PutText(stderr, "slots...");
    (* Get edges and count degrees: *)
    (* Each edge must appear exactly once. *)
    (* Vacant edges are allowed. *)
    <* ASSERT nS MOD 2 = 0 *>
    WITH 
      G = NEW(T).init(MAX(nV, allocNodes)),
      deg = NEW(REF ARRAY OF Degrees, nV)^,
      edge = NEW(REF FullEdges, nS DIV 2)^
    DO
      G.nV := nV; G.nE := nE;
      FOR u := 0 TO nV-1 DO deg[u] := Degrees{0,0,0} END;
      FOR ke := 0 TO nE-1 DO 
        WITH e = edge[ke] DO
          e.u := GetNode();
          IF e.u # NoNode THEN e.ku := GetSlot() END;
          e.dir := GetDir();
          e.v := GetNode();
          IF e.v # NoNode THEN e.kv := GetSlot() END;
          (* Update vertex degrees: *)
          IF e.u # NoNode THEN 
            WITH d = deg[e.u][+e.dir] DO d := MAX(d, e.ku+1) END
          END;
          IF e.v # NoNode THEN 
            WITH d = deg[e.v][-e.dir] DO d := MAX(d, e.kv+1) END
          END;
          FGet.EOL(rd);
          <* ASSERT e.u # NoNode OR e.v # NoNode *>
          IF e.dir = 0 THEN <* ASSERT e.u # e.v *> END;
        END;
      END;
      (* Build node lists, count slots: *)
      WITH nb = G.nb^ DO
        FOR v := 0 TO G.nV-1 DO
          FOR dir := -1 TO +1 DO
            WITH d = deg[v][dir], nbv = nb[v][dir] DO
              IF d = 0 THEN
                nbv := NoNodes
              ELSE
                nbv := NEW(REF Nodes, d);
                FOR k := 0 TO d-1 DO nbv[k] := BadNode END
              END;
              nS := nS - d
            END
          END
        END;
        <* ASSERT nS = 0 *>
        (* Fill slots with edge info: *)
        FOR ke := 0 TO LAST(edge) DO
          WITH e = edge[ke] DO
            IF e.u # NoNode THEN 
              <* ASSERT nb[e.u][+e.dir][e.ku] = BadNode *>
              nb[e.u][+e.dir][e.ku] := e.v
            END;
            IF e.v # NoNode THEN
              <* ASSERT nb[e.v][-e.dir][e.kv] = BadNode *>
              nb[e.v][-e.dir][e.kv] := e.u
            END;
            IF e.u # NoNode AND e.v # NoNode THEN DEC(nE) END;
          END
        END;
        <* ASSERT nE = 0 *>
        Wr.PutText(stderr, "footer...");
        FileFmt.ReadFooter(rd, "graph");
        Wr.PutText(stderr, "done)");
      END;
      RETURN G
    END
  END Read;
  
TYPE 
  FullEdge = RECORD
      dir: Dir;
      u: Node; ku: Slot;
      v: Node; kv: Slot;
    END;
  FullEdges = ARRAY OF FullEdge;

PROCEDURE Write(wr: Wr.T; G: T; comment: TEXT := "") =
  VAR nS: NAT;
  BEGIN 
    FileFmt.WriteHeader(wr, "graph", GraphFileVersion);
    FileFmt.WriteComment(wr, comment, '|'); 
    NPut.Int(wr, "nodes", G.nV); FPut.EOL(wr);
    NPut.Int(wr, "edges", G.nE); FPut.EOL(wr);
    (* Count slots: *)
    nS := 0;
    FOR u := 0 TO G.nV-1 DO
      WITH deg = G.degrees(u) DO
        nS := nS + deg[-1] + deg[00] + deg[+1]
      END;
    END;
    NPut.Int(wr, "slots", nS); FPut.EOL(wr);
    (* Put slot data: *)
    FOR u := 0 TO G.nV-1 DO
      FOR dir := -1 TO +1 DO
        FOR ku := 0 TO G.degree(u,dir) - 1 DO 
          FPut.Int(wr, u); Wr.PutChar(wr, ':'); FPut.Int(wr, ku);
          IF dir = 00 THEN Wr.PutText(wr, " - ") ELSE Wr.PutText(wr, " > ") END;
          WITH v = G.nbor(u,dir,ku) DO
            IF v = NoNode THEN
              Wr.PutChar(wr, '*')
            ELSE 
              IF dir = 00 THEN <* ASSERT u # v *> END;
              WITH kv = G.findSlot(v,-dir,u) DO
                FPut.Int(wr, v); Wr.PutChar(wr, ':'); FPut.Int(wr, kv)
              END
            END
          END;
          FPut.EOL(wr);
        END
      END;
      FileFmt.WriteFooter(wr, "graph");
    END;
  END Write;

PROCEDURE Identical(G, H: T): BOOL =
  BEGIN
    IF G.nV # H.nV THEN RETURN FALSE END;
    WITH nV = G.nV DO
      FOR u := 0 TO nV-1 DO
        WITH degG = G.degrees(u), degH = G.degrees(u) DO
          IF degG # degH THEN RETURN FALSE END;
          FOR dir := -1 TO +1 DO 
            FOR ku := 0 TO degG[dir]-1 DO
              IF G.nbor(u,dir,ku) # H.nbor(u,dir,ku) THEN RETURN FALSE END;
            END
          END
        END
      END
    END;
    RETURN TRUE
  END Identical;

PROCEDURE SortNodes(VAR uu: Nodes; cmp: NodeCompareProc) =
  VAR  q, r, mx: NAT;
       u, smx: Node;
  BEGIN
    (* Algorithm: heap sort *)
    WITH n = NUMBER(uu) DO
      (* 1. Build heap with largest element at uu[0] *)
      FOR  p := 0  TO n-1  DO
        u := uu[p];
        r := p;
        LOOP
          IF r = 0 THEN  EXIT  END;
          q := (r-1) DIV 2;
          IF cmp(uu[q], u) < 0  THEN
            uu[r] := uu[q];
          ELSE
            EXIT
          END;
          r := q
        END;
        uu[r] := u;
      END;
      (* 2. Remove elements from heap and insert at end *)
      FOR  p := n-1  TO 1  BY -1  DO
        (* save uu[p] *)
        u := uu[p];
        (* Move largest heap element to pos[p] *)
        uu[p] := uu[0];
        (* Insert u in remaining heap, from root down  *)
        q := 0;
        LOOP
          uu[q] := u;
          r := 2*q+1;
          (* Find largest among u, uu[LEFT(q)], uu[RIGHT(q)]  *)
          mx := q; smx := u;
          IF r < p AND cmp(smx, uu[r]) < 0  THEN
            mx := r; smx := uu[r]
          END;
          INC(r);
          IF r < p AND cmp(smx, uu[r]) < 0  THEN
            mx := r; smx := uu[r]
          END;
          (*  See who won  *)
          IF mx = q THEN
            (*  Stop here  *)
            EXIT
          ELSE
            (*  Promote child and advance  *)
            uu[q] := uu[mx];
            q := mx
          END
        END
      END;
      (* Paranoid check: *)
      FOR i := 1 TO n-1 DO <* ASSERT cmp(uu[i-1],uu[i]) <= 0 *> END
    END
  END SortNodes;

PROCEDURE ReSortNodes(VAR uu: Nodes; cmp: NodeCompareProc) =
  VAR j: NAT;
  BEGIN
    FOR i := 1 TO LAST(uu) DO
      VAR u := uu[i]; v: Node;
      BEGIN
        j := i;
        LOOP
          IF j = 0 THEN EXIT END;
          v := uu[j-1];
          IF cmp(u,v) >= 0 THEN EXIT END;
          uu[j] := v; DEC(j)
        END;
        IF j < i THEN uu[j] := u END;
      END
    END;
  END ReSortNodes;

PROCEDURE VerifyCompleteness(G: T; dir: Dir) =
  BEGIN
    WITH nV = G.nV DO
      FOR u := 0 TO nV-1 DO
        WITH deg = G.degree(u,dir) DO
          FOR ku := 0 TO deg-1 DO
            WITH v = G.nbor(u,dir,ku) DO <* ASSERT v # NoNode *> END
          END
        END
      END
    END;
  END VerifyCompleteness;

PROCEDURE VerifySlotInvariants(G: T) =
  BEGIN
    WITH nV = G.nV DO
      FOR u := 0 TO nV-1 DO
        FOR dir := -1 TO +1 DO 
          WITH deg = G.degree(u, dir) DO
            FOR ku := 0 TO deg-1 DO
              WITH v = G.nbor(u,dir,ku) DO
                IF dir = 0 THEN <* ASSERT v # u *> END;
                IF v # NoNode THEN 
                  FOR iu := 0 TO ku-1 DO 
                    WITH w = G.nbor(u,dir,iu) DO <* ASSERT w # v *> END
                  END;
                  WITH kv = G.findSlot(v,-dir,u) DO
                    <* ASSERT kv # NoSlot *>
                  END
                END
              END
            END
          END
        END
      END
    END;
  END VerifySlotInvariants;

BEGIN
  NoNodes := NEW(REF Nodes, 0);
END GDGraph.
(* Last edited on 2000-01-13 10:39:55 by stolfi *)