Sync

Task/Priority-queue/Component-Pascal/priority-queue-1.component

@@ -0,0 +1,88 @@
+MODULE PQueues;
+IMPORT StdLog,Boxes;
+
+TYPE
+	Rank* = POINTER TO RECORD
+		p-: LONGINT; (* Priority *)
+		value-: Boxes.Object
+	END;
+	
+	PQueue* = POINTER TO RECORD
+		a: POINTER TO ARRAY OF Rank;
+		size-: LONGINT;
+	END;
+	
+	PROCEDURE NewRank*(p: LONGINT; v: Boxes.Object): Rank;
+	VAR
+		r: Rank;
+	BEGIN
+		NEW(r);r.p := p;r.value := v;
+		RETURN r
+	END NewRank;
+	
+	PROCEDURE NewPQueue*(cap: LONGINT): PQueue;
+	VAR
+		pq: PQueue;
+	BEGIN
+		NEW(pq);pq.size := 0;
+		NEW(pq.a,cap);pq.a[0] := NewRank(MIN(INTEGER),NIL);
+		RETURN pq
+	END NewPQueue;
+	
+	PROCEDURE (pq: PQueue) Push*(r:Rank), NEW;
+	VAR
+		i: LONGINT;
+	BEGIN
+		INC(pq.size);
+		i := pq.size;
+		WHILE r.p < pq.a[i DIV 2].p DO
+			pq.a[i] := pq.a[i DIV 2];i := i DIV 2
+		END;
+		pq.a[i] := r
+	END Push;
+	
+	PROCEDURE (pq: PQueue) Pop*(): Rank,NEW;
+	VAR
+		r,y: Rank;
+		i,j: LONGINT;
+		ok: BOOLEAN;
+	BEGIN
+		r := pq.a[1]; (* Priority object *)
+		y := pq.a[pq.size]; DEC(pq.size); i := 1; ok := FALSE;
+		WHILE (i <= pq.size DIV 2) & ~ok DO
+			j := i + 1;
+			IF (j < pq.size) & (pq.a[i].p > pq.a[j + 1].p) THEN INC(j) END;
+			IF y.p > pq.a[j].p THEN pq.a[i] := pq.a[j]; i := j ELSE ok := TRUE END
+		END;
+		pq.a[i] := y;
+		RETURN r
+	END Pop;
+	
+	PROCEDURE (pq: PQueue) IsEmpty*(): BOOLEAN,NEW;
+	BEGIN
+		RETURN pq.size = 0
+	END IsEmpty;
+	
+	PROCEDURE Test*;
+	VAR
+		pq: PQueue;
+		r: Rank;
+		PROCEDURE ShowRank(r:Rank);
+		BEGIN
+			StdLog.Int(r.p);StdLog.String(":> ");StdLog.String(r.value.AsString());StdLog.Ln;
+		END ShowRank;
+	BEGIN
+		pq := NewPQueue(128);
+		pq.Push(NewRank(3,Boxes.NewString("Clear drains")));
+		pq.Push(NewRank(4,Boxes.NewString("Feed cat")));
+		pq.Push(NewRank(5,Boxes.NewString("Make tea")));
+		pq.Push(NewRank(1,Boxes.NewString("Solve RC tasks")));
+		pq.Push(NewRank(2,Boxes.NewString("Tax return")));
+		ShowRank(pq.Pop());
+		ShowRank(pq.Pop());
+		ShowRank(pq.Pop());
+		ShowRank(pq.Pop());
+		ShowRank(pq.Pop());
+	END Test;
+	
+END PQueues.

Task/Priority-queue/Component-Pascal/priority-queue-2.component

@@ -0,0 +1,22 @@
+DEFINITION PQueues;
+
+	IMPORT Boxes;
+
+	TYPE
+		PQueue = POINTER TO RECORD
+			size-: LONGINT;
+			(pq: PQueue) IsEmpty (): BOOLEAN, NEW;
+			(pq: PQueue) Pop (): Rank, NEW;
+			(pq: PQueue) Push (r: Rank), NEW
+		END;
+
+		Rank = POINTER TO RECORD
+			p-: LONGINT;
+			value-: Boxes.Object
+		END;
+
+	PROCEDURE NewPQueue (cap: LONGINT): PQueue;
+	PROCEDURE NewRank (p: LONGINT; v: Boxes.Object): Rank;
+	PROCEDURE Test;
+
+END PQueues.

Task/Priority-queue/Erlang/priority-queue.erl

@@ -0,0 +1,28 @@
+-module( priority_queue ).
+
+-export( [create/0, insert/3, peek/1, task/0, top/1] ).
+
+create() -> gb_trees:empty().
+
+insert( Element, Priority, Queue ) -> gb_trees:enter( Priority, Element, Queue ).
+
+peek( Queue ) ->
+	{_Priority, Element, _New_queue} = gb_trees:take_smallest( Queue ),
+	Element.
+
+task() ->
+	Items = [{3, "Clear drains"}, {4, "Feed cat"}, {5, "Make tea"}, {1, "Solve RC tasks"}, {2, "Tax return"}],
+	Queue = lists:foldl( fun({Priority, Element}, Acc) -> insert( Element, Priority, Acc ) end, create(), Items ),
+	io:fwrite( "peek priority: ~p~n", [peek( Queue )] ),
+	lists:foldl( fun(_N, Q) -> write_top( Q ) end, Queue, lists:seq(1, erlang:length(Items)) ).
+
+top( Queue ) ->
+	{_Priority, Element, New_queue} = gb_trees:take_smallest( Queue ),
+	{Element, New_queue}.
+
+
+
+write_top( Q ) ->
+	{Element, New_queue} = top( Q ),
+	io:fwrite( "top priority: ~p~n", [Element] ),
+	New_queue.

Task/Priority-queue/Fortran/priority-queue.f

@@ -0,0 +1,101 @@
+module priority_queue_mod
+implicit none
+
+type node
+  character (len=100)              :: task
+  integer                          :: priority
+end type
+
+type queue
+  type(node), allocatable :: buf(:)
+  integer                 :: n = 0
+contains
+  procedure :: top
+  procedure :: enqueue
+  procedure :: siftdown
+end type
+
+contains
+
+subroutine siftdown(this, a)
+  class (queue)           :: this
+  integer                 :: a, parent, child
+  associate (x => this%buf)
+  parent = a
+  do while(parent*2 <= this%n)
+    child = parent*2
+    if (child + 1 <= this%n) then
+      if (x(child+1)%priority > x(child)%priority ) then
+        child = child +1
+      end if
+    end if
+    if (x(parent)%priority < x(child)%priority) then
+      x([child, parent]) = x([parent, child])
+      parent = child
+    else
+      exit
+    end if
+  end do
+  end associate
+end subroutine
+
+function top(this) result (res)
+  class(queue) :: this
+  type(node)   :: res
+  res = this%buf(1)
+  this%buf(1) = this%buf(this%n)
+  this%n = this%n - 1
+  call this%siftdown(1)
+end function
+
+subroutine enqueue(this, priority, task)
+  class(queue), intent(inout) :: this
+  integer                     :: priority
+  character(len=*)            :: task
+  type(node)                  :: x
+  type(node), allocatable     :: tmp(:)
+  integer                     :: i
+  x%priority = priority
+  x%task = task
+  this%n = this%n +1
+  if (.not.allocated(this%buf)) allocate(this%buf(1))
+  if (size(this%buf)<this%n) then
+    allocate(tmp(2*size(this%buf)))
+    tmp(1:this%n-1) = this%buf
+    call move_alloc(tmp, this%buf)
+  end if
+  this%buf(this%n) = x
+  i = this%n
+  do
+    i = i / 2
+    if (i==0) exit
+    call this%siftdown(i)
+  end do
+end subroutine
+end module
+
+program main
+  use priority_queue_mod
+
+  type (queue) :: q
+  type (node)  :: x
+
+  call q%enqueue(3, "Clear drains")
+  call q%enqueue(4, "Feed cat")
+  call q%enqueue(5, "Make Tea")
+  call q%enqueue(1, "Solve RC tasks")
+  call q%enqueue(2, "Tax return")
+
+  do while (q%n >0)
+    x = q%top()
+    print "(g0,a,a)", x%priority, " -> ", trim(x%task)
+  end do
+
+end program
+
+! Output:
+! 5 -> Make Tea
+! 4 -> Feed cat
+! 3 -> Clear drains
+! 2 -> Tax return
+! 1 -> Solve RC tasks

Task/Priority-queue/Standard-ML/priority-queue.ml

@@ -15,7 +15,7 @@ let
     (5, "Make tea"),
     (1, "Solve RC tasks"),
     (2, "Tax return")]
-  val pq = foldr PQ.insert PQ.empty tasks
+  val pq = foldl PQ.insert PQ.empty tasks
   (* or val pq = PQ.fromList tasks *)
   fun aux pq' =
     case PQ.next pq' of