Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,43 +0,0 @@
|
|||
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;
|
||||
|
|
@ -1,29 +1,33 @@
|
|||
define :item [priority, value][
|
||||
print: [
|
||||
define :item [
|
||||
init: method [priority, value][
|
||||
this\priority: priority
|
||||
this\value: value
|
||||
]
|
||||
string: method [][
|
||||
~"(|this\priority|, |this\value|)"
|
||||
]
|
||||
]
|
||||
define :queue [items][
|
||||
init: [
|
||||
define :queue [
|
||||
init: method [items][
|
||||
this\items: arrange items 'it -> it\priority
|
||||
]
|
||||
|
||||
empty?: method [][
|
||||
zero? this\items
|
||||
]
|
||||
|
||||
push: method [item][
|
||||
this\items: this\items ++ item
|
||||
this\items: arrange this\items 'it -> it\priority
|
||||
]
|
||||
]
|
||||
|
||||
empty?: function [this :queue][
|
||||
zero? this\items
|
||||
]
|
||||
pop: method [][
|
||||
ensure [not? this\empty?]
|
||||
|
||||
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
|
||||
result: this\items\0
|
||||
this\items: remove.index this\items 0
|
||||
return result
|
||||
]
|
||||
]
|
||||
|
||||
Q: to :queue @[to [:item] [
|
||||
|
|
@ -33,13 +37,15 @@ Q: to :queue @[to [:item] [
|
|||
[1 "Solve RC tasks"]
|
||||
]]
|
||||
|
||||
push Q to :item [2 "Tax return"]
|
||||
do ::
|
||||
|
||||
print ["queue is empty?" empty? Q]
|
||||
print ""
|
||||
Q\push to :item [2 "Tax return"]
|
||||
|
||||
while [not? empty? Q]->
|
||||
print ["task:" pop Q]
|
||||
print ["queue is empty?" Q\empty?]
|
||||
print ""
|
||||
|
||||
print ""
|
||||
print ["queue is empty?" empty? Q]
|
||||
while [not? Q\empty?]->
|
||||
print ["task:" Q\pop]
|
||||
|
||||
print ""
|
||||
print ["queue is empty?" Q\empty?]
|
||||
|
|
|
|||
|
|
@ -1,286 +0,0 @@
|
|||
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.
|
||||
|
|
@ -1,104 +0,0 @@
|
|||
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
|
||||
Loading…
Add table
Add a link
Reference in a new issue