Data commit

Task/Priority-queue/Pascal/priority-queue-1.pas

@@ -0,0 +1,74 @@
+program PriorityQueueTest;
+
+uses Classes;
+
+Type
+ TItem = record
+    Priority:Integer;
+    Value:string;
+ end;
+
+ PItem = ^TItem;
+
+TPriorityQueue = class(Tlist)
+ procedure Push(Priority:Integer;Value:string);
+ procedure SortPriority();
+ function Pop():String;
+ function Empty:Boolean;
+end;
+
+{ TPriorityQueue }
+
+procedure TPriorityQueue.Push(Priority:Integer;Value:string);
+var
+ Item: PItem;
+begin
+    new(Item);
+    Item^.Priority := Priority;
+    Item^.Value := Value;
+    inherited Add(Item);
+    SortPriority();
+end;
+
+procedure TPriorityQueue.SortPriority();
+var
+ i,j:Integer;
+begin
+ if(Count < 2) Then  Exit();
+
+ for i:= 0 to Count-2 do
+  for j:= i+1 to Count-1 do
+    if ( PItem(Items[i])^.Priority > PItem(Items[j])^.Priority)then
+      Exchange(i,j);
+end;
+
+function TPriorityQueue.Pop():String;
+begin
+ if count = 0  then
+   Exit('');
+ result := PItem(First)^.value;
+ Dispose(PItem(First));
+ Delete(0);
+end;
+
+function TPriorityQueue.Empty:Boolean;
+begin
+ Result := Count = 0;
+end;
+
+var
+ Queue : TPriorityQueue;
+begin
+  Queue:= TPriorityQueue.Create();
+
+  Queue.Push(3,'Clear drains');
+  Queue.Push(4,'Feed cat');
+  Queue.Push(5,'Make tea');
+  Queue.Push(1,'Solve RC tasks');
+  Queue.Push(2,'Tax return');
+
+  while not Queue.Empty() do
+   writeln(Queue.Pop());
+
+  Queue.free;
+end.

Task/Priority-queue/Pascal/priority-queue-2.pas

@@ -0,0 +1,2 @@
+type
+  TComparer<T> = function(const L, R: T): Boolean;

Task/Priority-queue/Pascal/priority-queue-3.pas

@@ -0,0 +1,234 @@
+unit PQueue;
+{$mode objfpc}{$h+}{$b-}
+interface
+uses
+  SysUtils;
+
+type
+  EPqError = class(Exception);
+
+  generic TPriorityQueue<T> = class
+  public
+  type
+    TComparer = function(const L, R: T): Boolean;
+    THandle   = type SizeInt;
+  const
+    NULL_HANDLE = THandle(-1);
+  strict private
+  type
+    TNode = record
+      Data: T;
+      HeapIndex: SizeInt;
+    end;
+  const
+    INIT_SIZE          = 16;
+    NULL_INDEX         = SizeInt(-1);
+    SEUndefComparer    = 'Undefined comparer';
+    SEInvalidHandleFmt = 'Invalid handle value(%d)';
+    SEAccessEmpty      = 'Cannot access an empty queue item';
+  var
+    FNodes: array of TNode;
+    FHeap: array of SizeInt;
+    FCount,
+    FStackTop: SizeInt;
+    FCompare: TComparer;
+    procedure CheckEmpty;
+    procedure Expand;
+    function  NodeAdd(const aValue: T; aIndex: SizeInt): SizeInt;
+    function  NodeRemove(aIndex: SizeInt): T;
+    function  StackPop: SizeInt;
+    procedure StackPush(aIdx: SizeInt);
+    procedure PushUp(Idx: SizeInt);
+    procedure SiftDown(Idx: SizeInt);
+    function  DoPop: T;
+  public
+    constructor Create(c: TComparer);
+    function  IsEmpty: Boolean;
+    procedure Clear;
+    function  Push(const v: T): THandle;
+    function  Pop: T;
+    function  TryPop(out v: T): Boolean;
+    function  Peek: T;
+    function  TryPeek(out v: T): Boolean;
+    function  GetValue(h: THandle): T;
+    procedure Update(h: THandle; const v: T);
+    property  Count: SizeInt read FCount;
+  end;
+
+implementation
+
+procedure TPriorityQueue.CheckEmpty;
+begin
+  if Count = 0 then raise EPqError.Create(SEAccessEmpty);
+end;
+
+procedure TPriorityQueue.Expand;
+begin
+  if Length(FHeap) < INIT_SIZE then begin
+    SetLength(FHeap, INIT_SIZE);
+    SetLength(FNodes, INIT_SIZE)
+  end
+  else begin
+    SetLength(FHeap, Length(FHeap) * 2);
+    SetLength(FNodes, Length(FNodes) * 2);
+  end;
+end;
+
+function TPriorityQueue.NodeAdd(const aValue: T; aIndex: SizeInt): SizeInt;
+begin
+  if FStackTop <> NULL_INDEX then
+    Result := StackPop
+  else
+    Result := FCount;
+  FNodes[Result].Data := aValue;
+  FNodes[Result].HeapIndex := aIndex;
+  Inc(FCount);
+end;
+
+function TPriorityQueue.NodeRemove(aIndex: SizeInt): T;
+begin
+  StackPush(aIndex);
+  Result := FNodes[aIndex].Data;
+end;
+
+function TPriorityQueue.StackPop: SizeInt;
+begin
+  Result := FStackTop;
+  if Result <> NULL_INDEX then begin
+    FStackTop := FNodes[Result].HeapIndex;
+    FNodes[Result].HeapIndex := NULL_INDEX;
+  end;
+end;
+
+procedure TPriorityQueue.StackPush(aIdx: SizeInt);
+begin
+  FNodes[aIdx].HeapIndex := FStackTop;
+  FStackTop := aIdx;
+end;
+
+procedure TPriorityQueue.PushUp(Idx: SizeInt);
+var
+  Prev, Curr: SizeInt;
+begin
+  Prev := (Idx - 1) shr 1;
+  Curr := FHeap[Idx];
+  while(Idx > 0) and FCompare(FNodes[FHeap[Prev]].Data, FNodes[Curr].Data) do begin
+    FHeap[Idx] := FHeap[Prev];
+    FNodes[FHeap[Prev]].HeapIndex := Idx;
+    Idx := Prev;
+    Prev := (Prev - 1) shr 1;
+  end;
+  FHeap[Idx] := Curr;
+  FNodes[Curr].HeapIndex := Idx;
+end;
+
+procedure TPriorityQueue.SiftDown(Idx: SizeInt);
+var
+  Next, Sifted: SizeInt;
+begin
+  if Count < 2 then exit;
+  Next := Idx*2 + 1;
+  Sifted := FHeap[Idx];
+  while Next < Count do begin
+    if(Next+1 < Count)and FCompare(FNodes[FHeap[Next]].Data, FNodes[FHeap[Next+1]].Data)then Inc(Next);
+    if not FCompare(FNodes[Sifted].Data, FNodes[FHeap[Next]].Data) then break;
+    FHeap[Idx] := FHeap[Next];
+    FNodes[FHeap[Next]].HeapIndex := Idx;
+    Idx := Next;
+    Next := Next*2 + 1;
+  end;
+  FHeap[Idx] := Sifted;
+  FNodes[Sifted].HeapIndex := Idx;
+end;
+
+function TPriorityQueue.DoPop: T;
+begin
+  Result := NodeRemove(FHeap[0]);
+  Dec(FCount);
+  if Count > 0 then begin
+    FHeap[0] := FHeap[Count];
+    SiftDown(0);
+  end;
+end;
+
+constructor TPriorityQueue.Create(c: TComparer);
+begin
+  if c = nil then raise EPqError.Create(SEUndefComparer);
+  FCompare := c;
+  FStackTop := NULL_INDEX;
+end;
+
+function TPriorityQueue.IsEmpty: Boolean;
+begin
+  Result := Count = 0;
+end;
+
+procedure TPriorityQueue.Clear;
+begin
+  FNodes := nil;
+  FHeap := nil;
+  FCount := 0;
+  FStackTop := NULL_INDEX;
+end;
+
+function TPriorityQueue.Push(const v: T): THandle;
+var
+  InsertPos: SizeInt;
+begin
+  if Count = Length(FHeap) then Expand;
+  InsertPos := Count;
+  Result := NodeAdd(v, InsertPos);
+  FHeap[InsertPos] := Result;
+  if InsertPos > 0 then PushUp(InsertPos);
+end;
+
+function TPriorityQueue.Pop: T;
+begin
+  CheckEmpty;
+  Result := DoPop;
+end;
+
+function TPriorityQueue.TryPop(out v: T): Boolean;
+begin
+  if Count = 0 then exit(False);
+  v := DoPop;
+  Result := True;
+end;
+
+function TPriorityQueue.Peek: T;
+begin
+  CheckEmpty;
+  Result := FNodes[FHeap[0]].Data;
+end;
+
+function TPriorityQueue.TryPeek(out v: T): Boolean;
+begin
+  if Count = 0 then exit(False);
+  v := FNodes[FHeap[0]].Data;
+  Result := True;
+end;
+
+function TPriorityQueue.GetValue(h: THandle): T;
+begin
+  if SizeUInt(h) < SizeUInt(Length(FHeap)) then
+    Result := FNodes[h].Data
+  else
+    raise EPqError.CreateFmt(SEInvalidHandleFmt, [h]);
+end;
+
+procedure TPriorityQueue.Update(h: THandle; const v: T);
+begin
+  if SizeUInt(h) < SizeUInt(Length(FHeap)) then begin
+    if FCompare(FNodes[h].Data, v) then begin
+      FNodes[h].Data := v;
+      PushUp(FNodes[h].HeapIndex);
+    end else
+      if FCompare(v, FNodes[h].Data) then begin
+        FNodes[h].Data := v;
+        SiftDown(FNodes[h].HeapIndex);
+      end;
+  end else
+    raise EPqError.CreateFmt(SEInvalidHandleFmt, [h]);
+end;
+
+end.

Task/Priority-queue/Pascal/priority-queue-4.pas

@@ -0,0 +1,47 @@
+program PqDemo;
+{$mode delphi}
+uses
+  SysUtils, PQueue;
+
+type
+  TTask = record
+    Name: string; Prio: Integer;
+  end;
+
+const
+  Tasks: array of TTask = [
+    (Name: 'Clear drains';   Prio: 3), (Name: 'Feed cat';       Prio: 4),
+    (Name: 'Make tea';       Prio: 5), (Name: 'Solve RC tasks'; Prio: 1),
+    (Name: 'Tax return';     Prio: 2)];
+
+function TaskCmp(const L, R: TTask): Boolean;
+begin
+  Result := L.Prio < R.Prio;
+end;
+
+var
+  q: TPriorityQueue<TTask>;
+  h: q.THandle = q.NULL_HANDLE;
+  t: TTask;
+  MaxPrio: Integer = Low(Integer);
+begin
+  Randomize;
+  q := TPriorityQueue<TTask>.Create(@TaskCmp);
+  for t in Tasks do begin
+    if t.Prio > MaxPrio then MaxPrio := t.Prio;
+    if Pos('cat', t.Name) > 0 then
+      h := q.Push(t)
+    else
+      q.Push(t);
+  end;
+  if (h <> q.NULL_HANDLE) and Boolean(Random(2)) then begin
+    WriteLn('Cat is angry!');
+    t := q.GetValue(h);
+    t.Prio := Succ(MaxPrio);
+    q.Update(h, t);
+  end;
+  WriteLn('Task list:');
+  while q.TryPop(t) do
+    WriteLn('  ', t.Prio, ' ', t.Name);
+  q.Free;
+end.