aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
Download patch file Download diff file Expand all files Collapse all files

43
Task/Priority-queue/Ada/priority-queue.adb Normal file
View file

@ -0,0 +1,43 @@
with Ada.Containers.Synchronized_Queue_Interfaces;
with Ada.Containers.Unbounded_Priority_Queues;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
procedure Priority_Queues is
use Ada.Containers;
use Ada.Strings.Unbounded;
type Queue_Element is record
Priority : Natural;
Content : Unbounded_String;
end record;
function Get_Priority (Element : Queue_Element) return Natural is
begin
return Element.Priority;
end Get_Priority;
function Before (Left, Right : Natural) return Boolean is
begin
return Left > Right;
end Before;
package String_Queues is new Synchronized_Queue_Interfaces
(Element_Type => Queue_Element);
package String_Priority_Queues is new Unbounded_Priority_Queues
(Queue_Interfaces => String_Queues,
Queue_Priority => Natural);
My_Queue : String_Priority_Queues.Queue;
begin
My_Queue.Enqueue (New_Item => (Priority => 3, Content => To_Unbounded_String ("Clear drains")));
My_Queue.Enqueue (New_Item => (Priority => 4, Content => To_Unbounded_String ("Feed cat")));
My_Queue.Enqueue (New_Item => (Priority => 5, Content => To_Unbounded_String ("Make tea")));
My_Queue.Enqueue (New_Item => (Priority => 1, Content => To_Unbounded_String ("Solve RC tasks")));
My_Queue.Enqueue (New_Item => (Priority => 2, Content => To_Unbounded_String ("Tax return")));
declare
Element : Queue_Element;
begin
while My_Queue.Current_Use > 0 loop
My_Queue.Dequeue (Element => Element);
Ada.Text_IO.Put_Line (Natural'Image (Element.Priority) & " => " & To_String (Element.Content));
end loop;
end;
end Priority_Queues;

286
Task/Priority-queue/COBOL/priority-queue.cob Normal file
View file

@ -0,0 +1,286 @@
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.

72
Task/Priority-queue/Crystal/priority-queue.cr Normal file
View file

@ -0,0 +1,72 @@
class Heap (T)
@heap : Array(T)
def initialize (source : Array(T) = [] of T)
@heap = source.dup
heapify
end
def << (item)
@heap << item
siftup @heap.size - 1
self
end
def push (item)
self << item
end
def shift
new_head = @heap.pop
return new_head if @heap.empty?
result = @heap[0]
@heap[0] = new_head
siftdown 0
result
end
def empty?
@heap.empty?
end
def to_s (io)
io << "Heap"
@heap.to_s io
end
private def heapify
(@heap.size//2 - 1).downto(0) do |i|
siftdown i
end
end
private def siftdown (i)
n = @heap.size
loop do
j = i*2 + 1
return if j >= n
j += 1 if j+1 < n && @heap[j+1] < @heap[j]
return if @heap[i] <= @heap[j]
@heap.swap i, j
i = j
end
end
private def siftup (i)
loop do
j = (i-1)//2
break unless j >= 0 && @heap[i] < @heap[j]
@heap.swap i, j
i = j
end
end
end
tasks = [{3, "Clear drains"}, {4, "Feed cat"}, {5, "Make tea"},
{1, "Solve RC tasks"}, {2, "Tax return"}]
heap = Heap.new tasks
while !heap.empty?
puts heap.shift
end

96
Task/Priority-queue/JavaScript/priority-queue.js Normal file
View file

@ -0,0 +1,96 @@
class Task {
constructor(priority, name) {
this.priority = priority;
this.name = name;
}
toString() {
return `${this.priority}, ${this.name}`;
}
}
class PriorityQueue {
constructor() {
this.heap = [];
}
// Add a task to the heap
add(task) {
this.heap.push(task);
this.bubbleUp(this.heap.length - 1);
}
// Remove and return the highest priority task
remove() {
if (this.heap.length === 0) return null;
const min = this.heap[0];
const end = this.heap.pop();
if (this.heap.length > 0) {
this.heap[0] = end;
this.bubbleDown(0);
}
return min;
}
// Check if the queue is empty
isEmpty() {
return this.heap.length === 0;
}
// Move the element at index `i` up the heap
bubbleUp(i) {
const element = this.heap[i];
while (i > 0) {
const parentIndex = Math.floor((i - 1) / 2);
const parent = this.heap[parentIndex];
if (element.priority >= parent.priority) break;
this.heap[i] = parent;
i = parentIndex;
}
this.heap[i] = element;
}
// Move the element at index `i` down the heap
bubbleDown(i) {
const element = this.heap[i];
const length = this.heap.length;
while (true) {
const leftChildIndex = 2 * i + 1;
const rightChildIndex = 2 * i + 2;
let leftChild, rightChild;
let swap = null;
if (leftChildIndex < length) {
leftChild = this.heap[leftChildIndex];
if (leftChild.priority < element.priority) {
swap = leftChildIndex;
}
}
if (rightChildIndex < length) {
rightChild = this.heap[rightChildIndex];
if (
(swap === null && rightChild.priority < element.priority) ||
(swap !== null && rightChild.priority < leftChild.priority)
) {
swap = rightChildIndex;
}
}
if (swap === null) break;
this.heap[i] = this.heap[swap];
i = swap;
}
this.heap[i] = element;
}
}
// Usage
const pq = new PriorityQueue();
pq.add(new Task(3, "Clear drains"));
pq.add(new Task(4, "Feed cat"));
pq.add(new Task(5, "Make tea"));
pq.add(new Task(1, "Solve RC tasks"));
pq.add(new Task(2, "Tax return"));
while (!pq.isEmpty()) {
console.log(pq.remove().toString());
}

104
Task/Priority-queue/VBScript/priority-queue.vbs Normal file
View file

@ -0,0 +1,104 @@
option explicit
Class prio_queue
private size
private q
'adapt this function to your data
private function out_of_order(f1,f2): out_of_order = f1(0)>f2(0):end function
function peek
peek=q(1)
end function
property get qty
qty=size
end property
property get isempty
isempty=(size=0)
end property
function remove
dim x
x=q(1)
q(1)=q(size)
size=size-1
sift_down
remove=x
end function
sub add (x)
size=size+1
if size>ubound(q) then redim preserve q(ubound(q)*1.1)
q(size)=x
sift_up
end sub
Private sub swap (i,j)
dim x
x=q(i):q(i)=q(j):q(j)=x
end sub
private sub sift_up
dim h,p
h=size
p=h\2
if p=0 then exit sub
while out_of_order(q(p),q(h))
swap h,p
h=p
p=h\2
if p=0 then exit sub
wend
end sub
end sub
private sub sift_down
dim p,h
p=1
do
if p>=size then exit do
h =p*2
if h >size then exit do
if h+1<=size then if out_of_order(q(h),q(h+1)) then h=h+1
if out_of_order(q(p),q(h)) then swap h,p
p=h
loop
end sub
'Al instanciar objeto con New
Private Sub Class_Initialize( )
redim q(100)
size=0
End Sub
'When Object is Set to Nothing
Private Sub Class_Terminate( )
erase q
End Sub
End Class
'-------------------------------------
'test program
'---------------------------------
dim tasks:tasks=array(_
array(3,"Clear drains"),_
array(4,"Feed cat"),_
array(5,"Make tea"),_
array(1,"Solve RC tasks"),_
array(2,"Tax return"))
dim queue,i,x
set queue=new prio_queue
for i=0 to ubound(tasks)
queue.add(tasks(i))
next
wscript.echo "Done: " & queue.qty() &" items in queue. "& queue.peek()(1)& " is at the top." & vbcrlf
while not queue.isempty()
x=queue.remove()
wscript.echo x(0),x(1)
wend
set queue= nothing