Rosetta Code

Priority queue: Difference between revisions

Page Discussion

Priority queue (view source)

Revision as of 04:21, 9 May 2024

16,984 bytes added ,  11 days ago
m
→‎{{header|Zig}}
m (Fixed indentation issues)
 
(21 intermediate revisions by 10 users not shown)
Line 567:
with Ada.Containers.Unbounded_Priority_Queues;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
 
procedure Priority_Queues is
Line 608 ⟶ 609:
 
{{out}}
<pre></pre>
5 => Make tea
4 => Feed cat
3 => Clear drains
2 => Tax return
1 => Solve RC tasks
</pre>
 
=={{header|ARM Assembly}}==
Line 1,048 ⟶ 1,055:
Priority : 5 : Make tea
</pre>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="arturo">define :item [priority, value][
print: [
~"(|this\priority|, |this\value|)"
]
]
define :queue [items][
init: [
this\items: arrange this\items 'it -> it\priority
]
]
 
empty?: function [this :queue][
zero? this\items
]
 
push: function [this :queue, item][
this\items: this\items ++ item
this\items: arrange this\items 'it -> it\priority
]
 
pop: function [this :queue][
ensure -> not? empty? this
result: this\items\0
this\items: remove.index this\items 0
return result
]
 
Q: to :queue @[to [:item] [
[3 "Clear drains"]
[4 "Feed cat"]
[5 "Make tea"]
[1 "Solve RC tasks"]
]]
 
push Q to :item [2 "Tax return"]
 
print ["queue is empty?" empty? Q]
print ""
 
while [not? empty? Q]->
print ["task:" pop Q]
 
print ""
print ["queue is empty?" empty? Q]</syntaxhighlight>
 
{{out}}
 
<pre>queue is empty? false
 
task: (1, Solve RC tasks)
task: (2, Tax return)
task: (3, Clear drains)
task: (4, Feed cat)
task: (5, Make tea)
 
queue is empty? true</pre>
 
=={{header|ATS}}==
Line 1,483 ⟶ 1,550:
[1,"Solve RC tasks"]]
Type: List(OrderedKeyEntry(Integer,String))</pre>
 
=={{header|BASIC}}==
==={{header|FreeBASIC}}===
{{trans|VBA}}
<syntaxhighlight lang="freebasic">Type Tupla
Prioridad As Integer
Tarea As String
End Type
Dim Shared As Tupla a()
Dim Shared As Integer n 'número de eltos. en la matriz, el último elto. es n-1
 
Function Izda(i As Integer) As Integer
Izda = 2 * i + 1
End Function
 
Function Dcha(i As Integer) As Integer
Dcha = 2 * i + 2
End Function
 
Function Parent(i As Integer) As Integer
Parent = (i - 1) \ 2
End Function
 
Sub Intercambio(i As Integer, j As Integer)
Dim t As Tupla
t = a(i)
a(i) = a(j)
a(j) = t
End Sub
 
Sub bubbleUp(i As Integer)
Dim As Integer p = Parent(i)
Do While i > 0 And a(i).Prioridad < a(p).Prioridad
Intercambio i, p
i = p
p = Parent(i)
Loop
End Sub
 
Sub Annadir(fPrioridad As Integer, fTarea As String)
n += 1
If n > Ubound(a) Then Redim Preserve a(2 * n)
a(n - 1).Prioridad = fPrioridad
a(n - 1).Tarea = fTarea
bubbleUp (n - 1)
End Sub
 
Sub trickleDown(i As Integer)
Dim As Integer j, l, r
Do
j = -1
r = Dcha(i)
If r < n And a(r).Prioridad < a(i).Prioridad Then
l = Izda(i)
If a(l).Prioridad < a(r).Prioridad Then
j = l
Else
j = r
End If
Else
l = Izda(i)
If l < n And a(l).Prioridad < a(i).Prioridad Then j = l
End If
If j >= 0 Then Intercambio i, j
i = j
Loop While i >= 0
End Sub
 
Function Remove() As Tupla
Dim As Tupla x = a(0)
a(0) = a(n - 1)
n = n - 1
trickleDown 0
If 3 * n < Ubound(a) Then Redim Preserve a(Ubound(a) \ 2)
Remove = x
End Function
 
 
Redim a(4)
Annadir (3, "Clear drains")
Annadir (4, "Feed cat")
Annadir (5, "Make tea")
Annadir (1, "Solve RC tasks")
Annadir (2, "Tax return")
Dim t As Tupla
Do While n > 0
t = Remove
Print t.Prioridad; " "; t.Tarea
Loop
Sleep</syntaxhighlight>
{{out}}
<pre>
Igual que la entrada de VBA.
</pre>
 
=={{header|Batch File}}==
Line 2,231 ⟶ 2,392:
4: Feed cat
5: Make tea</pre>
 
=={{header|COBOL}}==
 
===IBM Enterprise COBOL solution===
 
Note that the logic of this implementation follows the C solution above for "Pairing heap w/ generic data types" except that the "generic type" (the TASK record defintion) is sized and allocated in the calling test program instead of in the priority queue subroutines.
 
Note also that each subroutine is declared RECURSIVE though they do not all need it.
 
The subroutines each pass back a return value in their last parameter. The most recent release of the IBM Enterprise COBOL compiler (V6.4 as of the date of this contribution) does, in fact, support user-defined functions, which would make some of this implementation a little easier to write and read, but since many IBM shops are not yet up to the most recent level, this version is offered as one that will work with down-level compiler versions.
 
In the "two pass merge" subroutine (PTYQ2PMG), the final three lines are needed because the COBOL CALL statement does not allow for expressions as arguments, so the arguments to the outer call to the "merge" subroutine must be executed first, and the results of those two calls become the arguments to the final "merge" call.
 
Note also that the subroutines call each other using "PIC X(8)" pseudonyms because the actually recursive subroutines cannot use the "same name" as both the PROGRAM-ID and as a variable name. This could be resolved by simply using "constant" calls (like <code>CALL "PTYQ2PMG" USING . . . </code> but using the pseudonyms allows each of the subroutines to also be separately compiled into an executable module and then dynamically loaded at run time. Many IBM shops will prefer that method to this purely "static" solution.
 
<syntaxhighlight lang="COBOL">
PROCESS NOSEQ,DS(S),AR(E),TEST(SO),CP(1047)
IDENTIFICATION DIVISION.
PROGRAM-ID. PTYQTEST
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* UNCOMMENT WITH DEBUGGING CLAUSE FOR DEBUG LINES TO EXECUTE.
SOURCE-COMPUTER.
Z-SYSTEM
* WITH DEBUGGING MODE
.
 
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PTYQ-PGMNAMES.
05 PTYQPUSH PIC X(8) VALUE "PTYQPUSH".
05 PTYQPOP PIC X(8) VALUE "PTYQPOP".
 
01 TASK-PTR POINTER.
 
01 TOP-PTR POINTER.
 
01 LINK-KEY PIC S9(8) COMP-5.
 
01 HEAP-PTR POINTER VALUE NULL.
 
01 PUSHD-PTR POINTER VALUE NULL.
 
01 POPPD-PTR POINTER VALUE NULL.
 
LINKAGE SECTION.
01 TASK.
05 TASK-NODE.
10 TASK-KEY PIC S9(8) COMP-5.
10 TASK-NEXT POINTER.
10 TASK-DOWN POINTER.
05 TASK-NAME PIC X(40).
 
PROCEDURE DIVISION.
ALLOCATE TASK RETURNING TASK-PTR
MOVE "EAT SCONES." TO TASK-NAME
MOVE +6 TO LINK-KEY
CALL PTYQPUSH USING TASK-PTR, LINK-KEY, HEAP-PTR, PUSHD-PTR
SET HEAP-PTR TO PUSHD-PTR
 
ALLOCATE TASK RETURNING TASK-PTR
MOVE "CLEAR DRAINS." TO TASK-NAME
MOVE +3 TO LINK-KEY
CALL PTYQPUSH USING TASK-PTR, LINK-KEY, HEAP-PTR, PUSHD-PTR
SET HEAP-PTR TO PUSHD-PTR
 
ALLOCATE TASK RETURNING TASK-PTR
MOVE "FEED CAT." TO TASK-NAME
MOVE +4 TO LINK-KEY
CALL PTYQPUSH USING TASK-PTR, LINK-KEY, HEAP-PTR, PUSHD-PTR
SET HEAP-PTR TO PUSHD-PTR
 
ALLOCATE TASK RETURNING TASK-PTR
MOVE "MAKE TEA." TO TASK-NAME
MOVE +5 TO LINK-KEY
CALL PTYQPUSH USING TASK-PTR, LINK-KEY, HEAP-PTR, PUSHD-PTR
SET HEAP-PTR TO PUSHD-PTR
 
ALLOCATE TASK RETURNING TASK-PTR
MOVE "SOLVE RC TASKS." TO TASK-NAME
MOVE +1 TO LINK-KEY
CALL PTYQPUSH USING TASK-PTR, LINK-KEY, HEAP-PTR, PUSHD-PTR
SET HEAP-PTR TO PUSHD-PTR
 
ALLOCATE TASK RETURNING TASK-PTR
MOVE "TAX RETURN." TO TASK-NAME
MOVE +2 TO LINK-KEY
CALL PTYQPUSH USING TASK-PTR, LINK-KEY, HEAP-PTR, PUSHD-PTR
SET HEAP-PTR TO PUSHD-PTR
 
PERFORM WITH TEST BEFORE UNTIL HEAP-PTR = NULL
SET TOP-PTR TO HEAP-PTR
SET ADDRESS OF TASK TO TOP-PTR
DISPLAY TASK-KEY " " TASK-NAME
CALL PTYQPOP USING HEAP-PTR, POPPD-PTR
SET HEAP-PTR TO POPPD-PTR
FREE TOP-PTR
END-PERFORM
GOBACK.
END PROGRAM PTYQTEST.
PROCESS NOSEQ,DS(S),AR(E),TEST(SO),CP(1047)
IDENTIFICATION DIVISION.
PROGRAM-ID. PTYQMERG RECURSIVE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* UNCOMMENT WITH DEBUGGING CLAUSE FOR DEBUG LINES TO EXECUTE.
SOURCE-COMPUTER.
Z-SYSTEM
* WITH DEBUGGING MODE
.
 
DATA DIVISION.
 
LINKAGE SECTION.
01 HEAP-PTRA POINTER.
 
01 HEAP-PTRB POINTER.
 
01 MERGD-PTR POINTER.
 
01 HEAPA.
05 HEAPA-KEY PIC S9(8) COMP-5 VALUE +0.
05 HEAPA-NEXT POINTER.
05 HEAPA-DOWN POINTER.
 
01 HEAPB.
05 HEAPB-KEY PIC S9(8) COMP-5 VALUE +0.
05 HEAPB-NEXT POINTER.
05 HEAPB-DOWN POINTER.
 
PROCEDURE DIVISION USING HEAP-PTRA, HEAP-PTRB, MERGD-PTR.
EVALUATE TRUE
WHEN HEAP-PTRA = NULL
SET MERGD-PTR TO HEAP-PTRB
WHEN HEAP-PTRB = NULL
SET MERGD-PTR TO HEAP-PTRA
WHEN OTHER
SET ADDRESS OF HEAPA TO HEAP-PTRA
SET ADDRESS OF HEAPB TO HEAP-PTRB
IF HEAPA-KEY < HEAPB-KEY
IF HEAPA-DOWN NOT = NULL
SET HEAPB-NEXT TO HEAPA-DOWN
END-IF
SET HEAPA-DOWN TO HEAP-PTRB
SET MERGD-PTR TO HEAP-PTRA
ELSE
IF HEAPB-DOWN NOT = NULL
SET HEAPA-NEXT TO HEAPB-DOWN
END-IF
SET HEAPB-DOWN TO HEAP-PTRA
SET MERGD-PTR TO HEAP-PTRB
END-IF
END-EVALUATE
GOBACK.
END PROGRAM PTYQMERG.
PROCESS NOSEQ,DS(S),AR(E),TEST(SO),CP(1047)
IDENTIFICATION DIVISION.
PROGRAM-ID. PTYQ2PMG RECURSIVE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* UNCOMMENT WITH DEBUGGING CLAUSE FOR DEBUG LINES TO EXECUTE.
SOURCE-COMPUTER.
Z-SYSTEM
* WITH DEBUGGING MODE
.
 
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PGMQMERG PIC X(8) VALUE "PTYQMERG".
01 PGMQ2PMG PIC X(8) VALUE "PTYQ2PMG".
 
LOCAL-STORAGE SECTION.
01 HEAP-PTRA POINTER.
 
01 HEAP-PTRB POINTER.
 
01 HEAP-REST POINTER.
 
01 MERG1-PTR POINTER.
 
01 MERG2-PTR POINTER.
 
LINKAGE SECTION.
01 HEAP-PTR POINTER.
 
01 MERGD-PTR POINTER.
 
01 HEAP.
05 HEAP-KEY PIC S9(8) COMP-5 VALUE +0.
05 HEAP-NEXT POINTER.
05 HEAP-DOWN POINTER.
 
01 HEAPA.
05 HEAPA-KEY PIC S9(8) COMP-5 VALUE +0.
05 HEAPA-NEXT POINTER.
05 HEAPA-DOWN POINTER.
 
01 HEAPB.
05 HEAPB-KEY PIC S9(8) COMP-5 VALUE +0.
05 HEAPB-NEXT POINTER.
05 HEAPB-DOWN POINTER.
 
01 REST.
05 REST-KEY PIC S9(8) COMP-5 VALUE +0.
05 REST-NEXT POINTER.
05 REST-DOWN POINTER.
 
PROCEDURE DIVISION USING HEAP-PTR, MERGD-PTR.
SET ADDRESS OF HEAP TO HEAP-PTR
EVALUATE TRUE
WHEN HEAP-PTR = NULL
SET MERGD-PTR TO HEAP-PTR
WHEN HEAP-NEXT = NULL
SET MERGD-PTR TO HEAP-PTR
WHEN OTHER
SET HEAP-PTRA TO HEAP-PTR
SET ADDRESS OF HEAPA TO HEAP-PTRA
SET HEAP-PTRB TO HEAP-NEXT
SET ADDRESS OF HEAPB TO HEAP-PTRB
SET HEAP-REST TO HEAPB-NEXT
SET ADDRESS OF REST TO HEAP-REST
SET HEAPA-NEXT TO NULL
SET HEAPB-NEXT TO NULL
CALL PGMQMERG USING HEAP-PTRA, HEAP-PTRB, MERG1-PTR
CALL PGMQ2PMG USING HEAP-REST, MERG2-PTR
CALL PGMQMERG USING MERG1-PTR, MERG2-PTR, MERGD-PTR
END-EVALUATE
GOBACK.
END PROGRAM PTYQ2PMG.
PROCESS NOSEQ,DS(S),AR(E),TEST(SO),CP(1047)
IDENTIFICATION DIVISION.
PROGRAM-ID. PTYQPUSH RECURSIVE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* UNCOMMENT WITH DEBUGGING CLAUSE FOR DEBUG LINES TO EXECUTE.
SOURCE-COMPUTER.
Z-SYSTEM
* WITH DEBUGGING MODE
.
 
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PTYQMERG PIC X(8) VALUE "PTYQMERG".
 
LINKAGE SECTION.
01 NODE-PTR POINTER.
 
01 LINK-KEY PIC S9(8) COMP-5.
 
01 HEAP-PTR POINTER.
 
01 PUSHD-PTR POINTER.
 
01 HEAP.
05 HEAP-KEY PIC S9(8) COMP-5.
05 HEAP-NEXT POINTER.
05 HEAP-DOWN POINTER.
 
01 NODE.
05 NODE-KEY PIC S9(8) COMP-5.
05 NODE-NEXT POINTER.
05 NODE-DOWN POINTER.
 
PROCEDURE DIVISION USING NODE-PTR, LINK-KEY, HEAP-PTR, PUSHD-PTR.
SET ADDRESS OF NODE TO NODE-PTR
SET ADDRESS OF HEAP TO HEAP-PTR
SET NODE-NEXT TO NULL
SET NODE-DOWN TO NULL
MOVE LINK-KEY TO NODE-KEY
CALL PTYQMERG USING NODE-PTR, HEAP-PTR, PUSHD-PTR
GOBACK.
END PROGRAM PTY2PUSH.
PROCESS NOSEQ,DS(S),AR(E),TEST(SO),CP(1047)
IDENTIFICATION DIVISION.
PROGRAM-ID. PTYQPOP RECURSIVE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* UNCOMMENT WITH DEBUGGING CLAUSE FOR DEBUG LINES TO EXECUTE.
SOURCE-COMPUTER.
Z-SYSTEM
* WITH DEBUGGING MODE
.
 
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PTYQ2PMG PIC X(8) VALUE "PTYQ2PMG".
 
LINKAGE SECTION.
01 HEAP-PTR POINTER.
 
01 POPPD-PTR POINTER.
 
01 HEAP.
05 HEAP-KEY PIC S9(8) COMP-5 VALUE +0.
05 HEAP-NEXT POINTER.
05 HEAP-DOWN POINTER.
 
PROCEDURE DIVISION USING HEAP-PTR, POPPD-PTR.
SET ADDRESS OF HEAP TO HEAP-PTR
CALL PTYQ2PMG USING HEAP-DOWN, POPPD-PTR
GOBACK.
END PROGRAM PTYQPOP.
</syntaxhighlight>
 
{{out}}
<pre>
+0000000001 SOLVE RC TASKS.
+0000000002 TAX RETURN.
+0000000003 CLEAR DRAINS.
+0000000004 FEED CAT.
+0000000005 MAKE TEA.
+0000000006 EAT SCONES.
</pre>
 
=={{header|CoffeeScript}}==
Line 3,397 ⟶ 3,871:
! 1 -> Solve RC tasks
</syntaxhighlight>
 
 
=={{header|FreeBASIC}}==
{{trans|VBA}}
<syntaxhighlight lang="freebasic">Type Tupla
Prioridad As Integer
Tarea As String
End Type
Dim Shared As Tupla a()
Dim Shared As Integer n 'número de eltos. en la matriz, el último elto. es n-1
 
Function Izda(i As Integer) As Integer
Izda = 2 * i + 1
End Function
 
Function Dcha(i As Integer) As Integer
Dcha = 2 * i + 2
End Function
 
Function Parent(i As Integer) As Integer
Parent = (i - 1) \ 2
End Function
 
Sub Intercambio(i As Integer, j As Integer)
Dim t As Tupla
t = a(i)
a(i) = a(j)
a(j) = t
End Sub
 
Sub bubbleUp(i As Integer)
Dim As Integer p = Parent(i)
Do While i > 0 And a(i).Prioridad < a(p).Prioridad
Intercambio i, p
i = p
p = Parent(i)
Loop
End Sub
 
Sub Annadir(fPrioridad As Integer, fTarea As String)
n += 1
If n > Ubound(a) Then Redim Preserve a(2 * n)
a(n - 1).Prioridad = fPrioridad
a(n - 1).Tarea = fTarea
bubbleUp (n - 1)
End Sub
 
Sub trickleDown(i As Integer)
Dim As Integer j, l, r
Do
j = -1
r = Dcha(i)
If r < n And a(r).Prioridad < a(i).Prioridad Then
l = Izda(i)
If a(l).Prioridad < a(r).Prioridad Then
j = l
Else
j = r
End If
Else
l = Izda(i)
If l < n And a(l).Prioridad < a(i).Prioridad Then j = l
End If
If j >= 0 Then Intercambio i, j
i = j
Loop While i >= 0
End Sub
 
Function Remove() As Tupla
Dim As Tupla x = a(0)
a(0) = a(n - 1)
n = n - 1
trickleDown 0
If 3 * n < Ubound(a) Then Redim Preserve a(Ubound(a) \ 2)
Remove = x
End Function
 
 
Redim a(4)
Annadir (3, "Clear drains")
Annadir (4, "Feed cat")
Annadir (5, "Make tea")
Annadir (1, "Solve RC tasks")
Annadir (2, "Tax return")
Dim t As Tupla
Do While n > 0
t = Remove
Print t.Prioridad; " "; t.Tarea
Loop
Sleep</syntaxhighlight>
{{out}}
<pre>
Igual que la entrada de VBA.
</pre>
 
=={{header|Frink}}==
Line 4,294 ⟶ 4,674:
{{out}}
<pre>Hello!</pre>
 
=={{header|Logtalk}}==
 
Logtalk comes with a [https://github.com/LogtalkDotOrg/logtalk3/tree/master/library/heaps heap implementation] out of the box. As such it by definition also has a priority queue. It can be used at the toplevel like this (with some formatting changes for clarity, and <code>%</code> marking comments that would not be in the output):
 
<syntaxhighlight lang="logtalk">?- logtalk_load(heaps(loader)). % also `{heaps(loader)}.` on most back-ends
% output varies by settings and what's already been loaded
?- heap(<)::new(H0), % H0 contains an empty heap
heap(<)::insert(3, 'Clear drains', H0, H1), % as with Prolog, variables are in the mathematical
% sense: immutable, so we make a new heap from the empty one
heap(<)::insert(4, 'Feed cat',H1, H2), % with each insertion a new heap
heap(<)::top(H2, K2, V2), % K2=3, V2='Clear drains',
% H2=t(2, [], t(3, 'Clear drains', t(4, 'Feed cat', t, t), t))
heap(<)::insert_all(
[
5-'Make tea',
1-'Solve RC tasks',
2-'Tax return'
], H2, H3), % it's easier and more efficient to add items in K-V pairs
heap(<)::top(H3, K3, V3), % K3=1, V3='Solve RC tasks',
% H3=t(5, [], t(1, 'Solve RC tasks', t(3, 'Clear drains',
% t(4, 'Feed cat', t, t), t), t(2, 'Tax return',
% t(5, 'Make tea', t, t), t))),
heap(<)::delete(H3, K3, V3, H4), % K3=1, V3='Solve RC tasks',
% H4=t(4, [5], t(2, 'Tax return', t(3, 'Clear drains',
% t(4, 'Feed cat', t, t), t), t(5, 'Make tea', t, t))),
heap(<)::top(H4, K4, V4). % K4=2, V4='Tax return'</syntaxhighlight>
 
Since <code>heap(Ordering)</code> is a parametrized object in Logtalk, with the parameter being the ordering predicate, we actually use <code>heap(<)</code> object to get min ordering. There are two objects provided in Logtalk that eliminate the unnecessary replication of the two most common orderings:
 
<syntaxhighlight lang="logtalk">:- object(minheap,
extends(heap(<))).
 
:- info([
version is 1:0:0,
author is 'Paulo Moura.',
date is 2010-02-19,
comment is 'Min-heap implementation. Uses standard order to compare keys.'
]).
 
:- end_object.
 
 
:- object(maxheap,
extends(heap(>))).
 
:- info([
version is 1:0:0,
author is 'Paulo Moura.',
date is 2010-02-19,
comment is 'Max-heap implementation. Uses standard order to compare keys.'
]).
 
:- end_object.</syntaxhighlight>
 
Given the presence of these two objects, all of the example code above could have <code>heap(<)</code> replaced with <code>minheap</code> for identical results (including identical performance). It also illustrates how quickly and easily other orderings could be provided at need.
 
=={{header|Lua}}==
Line 5,914 ⟶ 6,350:
 
=={{header|Perl}}==
===Using a Module===
There are a few implementations on CPAN. Following uses <code>Heap::Priority</code>[http://search.cpan.org/~fwojcik/Heap-Priority-0.11/Priority.pm]
<syntaxhighlight lang="perl">use 5.10.0strict;
use strictwarnings;
use feature 'say';
use Heap::Priority;
 
my $h = new Heap::Priority->new;
 
$h->highest_first(); # higher or lower number is more important
Line 5,928 ⟶ 6,366:
["Tax return", 2];
 
say while ($_ = $h->pop);</syntaxhighlight>output<syntaxhighlight lang="text">Make tea
{{out}}
<pre>
Make tea
Feed cat
Clear drains
Tax return
Solve RC tasks</syntaxhighlight>
</pre>
===IBM card sorter version===
<syntaxhighlight lang="perl">#!/usr/bin/perl
 
===IBM card sorter version===
use strict; # https://rosettacode.org/wiki/Priority_queue
<syntaxhighlight lang="perl">use strict;
use warnings; # in homage to IBM card sorters :)
 
Line 8,033 ⟶ 8,474:
Print
 
Proc _Insert(3, Dup("Clear drains")) ' insert the whole bunch
Proc _Insert(4, Dup("Feed cat"))
Proc _Insert(5, Dup("Make tea"))
Proc _Insert(1, Dup("Solve RC tasks"))
Proc _Insert(2, Dup("Tax return"))
 
For x = 0 To b: Proc _List(x) : Next ' list all entries
Line 8,053 ⟶ 8,494:
Local (2)
' return dummy on error
If b < 0 Then Return (Dup("0No such entry"))
a@ = @(0)) ' save the top entry
For b@ = 0 To Set(b, b - 1) : @(b@) = @(b@+1): Next
Line 8,320 ⟶ 8,761:
{{libheader|Wren-queue}}
The above module contains a PriorityQueue class. Unlike some other languages here, the higher the number, the higher the priority. So the 'Make tea' task has the highest priority and, thankfully, the cat has a good chance of being fed!
<syntaxhighlight lang="ecmascriptwren">import "./queue" for PriorityQueue
 
var tasks = PriorityQueue.new()
Line 8,447 ⟶ 8,888:
 
()</syntaxhighlight>
 
=={{header|XPL0}}==
The highest priority item is the one with the minimum number, as in 1st priority.
<syntaxhighlight lang "XPL0">def PQSize = 10; \Maximum number of items priority queue can hold
int PQ(PQSize*2), PQI;
 
func Remove; \Remove and return item with highest priority
int Min, I, MinI, Item;
[if PQI <= 0 then return 0;
Min:= -1>>1; I:= PQI;
while I > 0 do
[I:= I-2;
if PQ(I) < Min then
[Min:= PQ(I);
MinI:= I;
];
];
Item:= PQ(MinI+1); \get highest priority Item
PQI:= PQI-2;
PQ(MinI):= PQ(PQI); \replace that Item with last item
PQ(MinI+1):= PQ(PQI+1);
return Item;
];
 
proc Insert(Priority, Item); \Insert item into priority queue
int Priority, Item;
[if PQI >= PQSize*2 then return;
PQ(PQI):= Priority;
PQ(PQI+1):= Item;
PQI:= PQI+2;
];
 
int Items, I;
[Items:= [
[3, "Clear drains"],
[4, "Feed cat"],
[5, "Make tea"],
[1, "Solve RC tasks"],
[2, "Tax return"] ];
PQI:= 0;
for I:= 0 to 5-1 do
Insert(Items(I,0), Items(I,1));
while PQI > 0 do
[Text(0, Remove); CrLf(0)];
]</syntaxhighlight>
{{out}}
<pre>
Solve RC tasks
Tax return
Clear drains
Feed cat
Make tea
</pre>
 
=={{header|Zig}}==
Line 8,481 ⟶ 8,975:
/// fn(T, T) bool
const Comparator = struct {
fn maxCompare(_: void, a: Task, b: Task) boolstd.math.Order {
return std.math.order(a.priority >, b.priority);
}
 
fn minCompare(_: void, a: Task, b: Task) boolstd.math.Order {
return std.math.order(a.priority <, b.priority);
}
};
Line 8,493 ⟶ 8,987:
var arena = std.heap.ArenaAllocator.init(std.heap.page_allocator);
defer arena.deinit();
varconst allocator = &arena.allocator();
var pq = PriorityQueue(Task, void, Comparator.maxCompare).init(allocator, {});
 
var pq = PriorityQueue(Task).init(allocator, Comparator.maxCompare);
defer pq.deinit();
 
Line 8,503 ⟶ 8,996:
try pq.add(Task.init(1, "Solve RC tasks"));
try pq.add(Task.init(2, "Tax returns"));
try testing.expectEqual(pq.count(), 5);
 
std.debug.print("\n", .{});
Line 8,510 ⟶ 9,003:
while (pq.count() != 0) {
const task = pq.remove();
std.debug.print("Executing: {s} (priority {d})\n", .{ task.name, task.priority });
}
std.debug.print("\n", .{});
Line 8,518 ⟶ 9,011:
var arena = std.heap.ArenaAllocator.init(std.heap.page_allocator);
defer arena.deinit();
varconst allocator = &arena.allocator();
var pq = PriorityQueue(Task, void, Comparator.minCompare).init(allocator, {});
 
var pq = PriorityQueue(Task).init(allocator, Comparator.minCompare);
defer pq.deinit();
 
Line 8,528 ⟶ 9,020:
try pq.add(Task.init(1, "Solve RC tasks"));
try pq.add(Task.init(2, "Tax returns"));
try testing.expectEqual(pq.count(), 5);
 
std.debug.print("\n", .{});
Line 8,535 ⟶ 9,027:
while (pq.count() != 0) {
const task = pq.remove();
std.debug.print("Executing: {s} (priority {d})\n", .{ task.name, task.priority });
}
std.debug.print("\n", .{});
}
 
</syntaxhighlight>
 
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/334931...364343"