mentor/src/pqueue/PQAlgs.m3


 Copyright (C) 1994, Digital Equipment Corporation         
 All rights reserved.                                      
 See the file COPYRIGHT for a full description.            
                                                           
 Last modified on Tue Jan 31 15:40:29 PST 1995 by kalsow   
      modified on Thu Jan  5 23:27:41 PST 1995 by najork   
      modified on Thu Sep 24 12:51:49 PDT 1992 by mhb      
      modified on Tue Sep  8 21:04:03 PDT 1992 by johnh    
      modified on Fri Jul 31 18:13:26 PDT 1992 by owicki   

MODULE PQAlgs;

IMPORT Algorithm, PQueueAlgClass, PQueueIE, FormsVBT, Random, Thread,
       VBT, ZeusCodeView, ZeusPanel, RefList, PQueue;

FROM PQueue IMPORT PriorityQueue;

<* FATAL FormsVBT.Error, FormsVBT.Unimplemented *>
TYPE
  T = PQueueAlgClass.T BRANDED OBJECT
      wq: PQueue.WorkQueue
    OVERRIDES
      run := Run;
    END;

PROCEDURE At(alg: T; line: INTEGER) RAISES {Thread.Alerted} =
  BEGIN
    ZeusCodeView.Event(alg, line)
  END At;

PROCEDURE Insert(alg: T;  pq: PriorityQueue; v: INTEGER)
    RAISES {Thread.Alerted}=
  BEGIN
                IF pq.size < pq.maxSize THEN
                  ZeusCodeView.Event(alg, procedureName := "Insert");
At(alg, 101);     INC(pq.size); pq.heap[pq.size] := v;
                  PQueueIE.Insert(alg, v);
                  IF pq.size > 1 THEN UpHeap(alg, pq, pq.size) END;
                  ZeusCodeView.Exit(alg);
                END;
  END Insert;

               PROCEDURE UpHeap(alg: T; pq: PriorityQueue; k:INTEGER)
                   RAISES {Thread.Alerted}=
                 VAR v: INTEGER;
                 BEGIN
                 ZeusCodeView.Event(alg, procedureName := "UpHeap");
At(alg, 201);    v := pq.heap[k]; pq.heap[0] := LAST(INTEGER);
                 PQueueIE.HeapOpInit(alg, k);
At(alg, 202);    WHILE k > 1 DO
                   PQueueIE.Compare(alg, k DIV 2, 0);
                   IF pq.heap[k DIV 2] > v THEN EXIT END;
                   PQueueIE.HeapStep(alg, k, k DIV 2, FALSE);
                   pq.heap[k] := pq.heap[k DIV 2]; k := k DIV 2
                 END;
At(alg,204);     pq.heap[k] := v;
                 PQueueIE.PlaceElement(alg, k);
                 ZeusCodeView.Exit(alg);
  END UpHeap;

               PROCEDURE Remove(alg: T; pq: PriorityQueue): INTEGER
                   RAISES {Thread.Alerted}=
               VAR outVal := pq.heap[1];
               BEGIN
                 ZeusCodeView.Event(alg, procedureName := "Remove");
                 IF pq.size > 0 THEN
At(alg, 301);      pq.heap[1] := pq.heap[pq.size]; DEC(pq.size);
                   PQueueIE.Remove(alg);
At(alg, 302);      IF pq.size > 1 THEN DownHeap(alg, pq, 1); END;
                   ZeusCodeView.Exit(alg);
At(alg, 303);      RETURN outVal;
                 ELSE
                   ZeusCodeView.Exit(alg);
                   RETURN 0 (* for now, so as not to crash *)
                 END;
               END Remove;

PROCEDURE DownHeap(alg: T; pq: PriorityQueue; k: INTEGER)
    RAISES {Thread.Alerted}=
  VAR j, v: INTEGER;
               BEGIN
                 ZeusCodeView.Event(alg, procedureName := "DownHeap");
At(alg, 401);    v := pq.heap[k]; PQueueIE.HeapOpInit(alg,k);
                 WHILE k <= pq.size DIV 2 DO
At(alg,402);       j := k+k;
                   IF j+1 > pq.size THEN
                     PQueueIE.Compare(alg, j, 0);
                   ELSE
                     PQueueIE.Compare(alg, j, j+1);
                   END;
                  IF j < pq.size THEN
                                IF pq.heap[j] < pq.heap[j+1] THEN
                                   INC(j)
                    END;
                  END;
At(alg, 406);      IF v >= pq.heap[j] THEN
                     EXIT;
                   END;
At(alg, 408);      PQueueIE.HeapStep(alg, k,j, TRUE);
                       pq.heap[k] := pq.heap[j]; k := j;
                 END;
At(alg, 409);    pq.heap[k] := v; PQueueIE.PlaceElement(alg, k);
                 ZeusCodeView.Exit(alg);
               END DownHeap;

PROCEDURE Replace(alg: T; pq: PriorityQueue; v: INTEGER): INTEGER
    RAISES {Thread.Alerted} =
  BEGIN
    pq.heap[0] := v;
    IF pq.size > 1 THEN DownHeap(alg, pq, 0); END;
    RETURN pq.heap[0]
  END Replace;

PROCEDURE HeapSort(alg: T;  pq: PriorityQueue)
    RAISES {Thread.Alerted} =
  VAR t: INTEGER;
  BEGIN
                 ZeusCodeView.Event(alg, procedureName := "HeapSort");
At(alg, 501);    FOR k := pq.size DIV 2 TO 1 BY -1 DO
At(alg, 502);      DownHeap(alg, pq, k);
                 END;
At(alg, 503);    PQueueIE.Pause(alg);
                 PQueueIE.Pause(alg);
                 WHILE pq.size > 1 DO
At(alg, 504);      PQueueIE.SortStep(alg, pq.size);
                   t := pq.heap[1]; pq.heap[1] := pq.heap[pq.size];
                   pq.heap[pq.size] := t;
                   DEC(pq.size);
At(alg, 505);      IF pq.size > 1 THEN DownHeap(alg, pq, 1); END;
                 END;
                 PQueueIE.SortStep(alg, pq.size);
  END HeapSort;

PROCEDURE Run (alg: T) RAISES {Thread.Alerted} =
  VAR
    pq := NEW(PriorityQueue);
    doSort: BOOLEAN;
    rand := NEW (Random.Default).init ();
  BEGIN
    doSort := FormsVBT.GetBoolean(alg.data, "sort");
    IF doSort THEN
      pq.size := FormsVBT.GetInteger(alg.data, "N");
      pq.maxSize := pq.size
    ELSE
      pq.maxSize := FormsVBT.GetInteger(alg.data, "qSize");
      pq.size := 0;
    END;
    PQueueIE.Setup(alg, pq.maxSize, doSort);
    pq.heap := NEW(REF ARRAY OF INTEGER, pq.maxSize+1);
    IF doSort THEN
      FOR i := 1 TO pq.size DO
        pq.heap[i] := rand.integer (PQueue.MinElt, PQueue.MaxElt);
      END;
      PQueueIE.InitSort(alg, pq.heap);
      HeapSort(alg, pq)
    ELSE
      LOCK alg.wq DO alg.wq.q := NIL END;
      WHILE TRUE DO
        WITH operation = alg.wq.removeElement(),
             op = NARROW (operation.head, REF PQueue.QueueOp)^,
             p1 = NARROW (operation.tail.head, REF INTEGER)^ DO
          CASE op OF
          | PQueue.QueueOp.Insert =>
            Insert(alg, pq, p1);
          | PQueue.QueueOp.Replace =>
            EVAL Replace(alg, pq, p1);
          | PQueue.QueueOp.Remove =>
            EVAL Remove(alg, pq)
          END;
        END;
      END;
    END;
  END Run;

PROCEDURE New (): Algorithm.T =
  VAR
    cv := RefList.List1(RefList.List2("Modula-3 Code View", "pqueueAlgs.m3"));
    fv := ZeusPanel.NewForm("pqueueinput.fv");
    newWq := NEW(PQueue.WorkQueue, q := NIL, c := NEW(Thread.Condition));
    alg := NEW(T, data := fv, codeViews := cv, wq := newWq).init();
  BEGIN
    FormsVBT.AttachProc(fv, "insert", HandleInsert, alg);
    (*  FormsVBT.AttachProc(fv, "replace", HandleReplace, alg); *)
    FormsVBT.AttachProc(fv, "remove", HandleRemove, alg);
    RETURN alg;
  END New;

PROCEDURE HandleRemove(<* UNUSED *> form: FormsVBT.T;
    <* UNUSED *> event: TEXT;
                 cl: REFANY;
    <* UNUSED *> ts: VBT.TimeStamp) =
  VAR alg := NARROW(cl, T);
  BEGIN
    alg.wq.addElement(PQueue.QueueOp.Remove);
  END HandleRemove;

<* UNUSED *> PROCEDURE HandleReplace(<* UNUSED *> form: FormsVBT.T;
    <* UNUSED *> event: TEXT;
                 cl: REFANY;
    <* UNUSED *> ts: VBT.TimeStamp) =
  VAR alg := NARROW(cl, T);
  BEGIN
    alg.wq.addElement(PQueue.QueueOp.Replace,
           FormsVBT.GetInteger(alg.data, "rplelt") );
  END HandleReplace;

PROCEDURE HandleInsert(<* UNUSED *> form: FormsVBT.T;
    <* UNUSED *> event: TEXT;
                 cl: REFANY;
    <* UNUSED *> ts: VBT.TimeStamp) =
  VAR alg := NARROW(cl, T);
  BEGIN
    alg.wq.addElement(PQueue.QueueOp.Insert,
           FormsVBT.GetInteger(alg.data, "inselt") );
  END HandleInsert;

BEGIN
  ZeusPanel.RegisterAlg(New, "HeapSort", "PQueue");
END PQAlgs.