Initial data commit

This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions

View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Priority_queue

View file

@ -0,0 +1,30 @@
A [[wp:Priority queue|priority queue]] is somewhat similar to a [[Queue|queue]], with an important distinction: each item is added to a priority queue with a priority level, and will be later removed from the queue with the highest priority element first. That is, the items are (conceptually) stored in the queue in priority order instead of in insertion order.
;Task:
Create a priority queue.   The queue must support at least two operations:
:#   Insertion.   An element is added to the queue with a priority (a numeric value).
:#   Top item removal.   Deletes the element or one of the elements with the current top priority and return it.
Optionally, other operations may be defined, such as peeking (find what current top priority/top element is), merging (combining two priority queues into one), etc.
To test your implementation, insert a number of elements into the queue, each with some random priority.
Then dequeue them sequentially; now the elements should be sorted by priority.
You can use the following task/priority items as input data:
'''Priority''' '''Task'''
══════════ ════════════════
3 Clear drains
4 Feed cat
5 Make tea
1 Solve RC tasks
2 Tax return
The implementation should try to be efficient.   A typical implementation has   '''O(log n)'''   insertion and extraction time,   where   '''n'''   is the number of items in the queue.
You may choose to impose certain limits such as small range of allowed priority levels, limited capacity, etc.   If so, discuss the reasons behind it.
<br><br>

View file

@ -0,0 +1,4 @@
V items = [(3, Clear drains), (4, Feed cat), (5, Make tea), (1, Solve RC tasks), (2, Tax return)]
minheap:heapify(&items)
L !items.empty
print(minheap:pop(&items))

View file

@ -0,0 +1,371 @@
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program priorQueue64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ NBMAXIELEMENTS, 100
/*******************************************/
/* Structures */
/********************************************/
/* example structure item */
.struct 0
item_priority: // priority
.struct item_priority + 8
item_address: // string address
.struct item_address + 8
item_fin:
/* example structure heap */
.struct 0
heap_size: // heap size
.struct heap_size + 8
heap_items: // structure of items
.struct heap_items + (item_fin * NBMAXIELEMENTS)
heap_fin:
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessEmpty: .asciz "Empty queue. \n"
szMessNotEmpty: .asciz "Not empty queue. \n"
szMessError: .asciz "Error detected !!!!. \n"
szMessResult: .asciz "Priority : @ : @ \n" // message result
szString1: .asciz "Clear drains"
szString2: .asciz "Feed cat"
szString3: .asciz "Make tea"
szString4: .asciz "Solve RC tasks"
szString5: .asciz "Tax return"
szCarriageReturn: .asciz "\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
.align 4
sZoneConv: .skip 24
Queue1: .skip heap_fin // queue memory place
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrQueue1 // queue structure address
bl isEmpty
cbz x0,1f
ldr x0,qAdrszMessEmpty
bl affichageMess // display message empty
b 2f
1:
ldr x0,qAdrszMessNotEmpty
bl affichageMess // display message not empty
2:
// init item 1
ldr x0,qAdrQueue1 // queue structure address
mov x1,#3 // priority
ldr x2,qAdrszString1
bl pushQueue // add item in queue
cmp x0,#-1 // error ?
beq 99f
ldr x0,qAdrQueue1 // queue structure address
bl isEmpty
cbz x0,3f // not empty
ldr x0,qAdrszMessEmpty
bl affichageMess // display message empty
b 4f
3:
ldr x0,qAdrszMessNotEmpty
bl affichageMess // display message not empty
4:
// init item 2
ldr x0,qAdrQueue1 // queue structure address
mov x1,#4 // priority
ldr x2,qAdrszString2
bl pushQueue // add item in queue
cmp x0,#-1 // error ?
beq 99f
// init item 3
ldr x0,qAdrQueue1 // queue structure address
mov x1,#5 // priority
ldr x2,qAdrszString3
bl pushQueue // add item in queue
cmp x0,#-1 // error ?
beq 99f
// init item 4
ldr x0,qAdrQueue1 // queue structure address
mov x1,#1 // priority
ldr x2,qAdrszString4
bl pushQueue // add item in queue
cmp x0,#-1 // error ?
beq 99f
// init item 5
ldr x0,qAdrQueue1 // queue structure address
mov x1,#2 // priority
ldr x2,qAdrszString5
bl pushQueue // add item in queue
cmp x0,#-1 // error ?
beq 99f
5:
ldr x0,qAdrQueue1 // queue structure address
bl popQueue // return item
cmp x0,#-1 // end ?
beq 100f
mov x2,x1 // save string address
ldr x1,qAdrsZoneConv // conversion priority
bl conversion10 // decimal conversion
ldr x0,qAdrszMessResult
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc
mov x1,x2 // string address
bl strInsertAtCharInc
bl affichageMess // display message
b 5b // loop
99: // error
ldr x0,qAdrszMessError
bl affichageMess
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrQueue1: .quad Queue1
qAdrszString1: .quad szString1
qAdrszString2: .quad szString2
qAdrszString3: .quad szString3
qAdrszString4: .quad szString4
qAdrszString5: .quad szString5
qAdrszMessError: .quad szMessError
qAdrszMessEmpty: .quad szMessEmpty
qAdrszMessNotEmpty: .quad szMessNotEmpty
qAdrszMessResult: .quad szMessResult
qAdrszCarriageReturn: .quad szCarriageReturn
//qAdrsMessPriority: .quad sMessPriority
qAdrsZoneConv: .quad sZoneConv
/******************************************************************/
/* test if queue empty */
/******************************************************************/
/* x0 contains the address of queue structure */
isEmpty:
stp x1,lr,[sp,-16]! // save registres
ldr x1,[x0,#heap_size] // heap size
cmp x1,#0
cset x0,eq
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/******************************************************************/
/* add item in queue */
/******************************************************************/
/* x0 contains the address of queue structure */
/* x1 contains the priority of item */
/* x2 contains the string address */
pushQueue:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
ldr x3,[x0,#heap_size] // heap size
cbnz x3,1f // heap empty ?
add x4,x0,#heap_items // address of item structure
str x1,[x4,#item_priority] // store in first item
str x2,[x4,#item_address]
mov x3,#1 // heap size
str x3,[x0,#heap_size] // new heap size
b 100f
1:
mov x4,x3 // maxi index
lsr x5,x4,#1 // current index = maxi / 2
mov x8,x1 // save priority
mov x9,x2 // save string address
2: // insertion loop
cmp x4,#0 // end loop ?
ble 3f
mov x6,#item_fin // item size
madd x6,x5,x6,x0 // item shift
add x6,x6,#heap_items // compute address item
ldr x7,[x6,#item_priority] // load priority
cmp x7,x8 // compare priority
ble 3f // <= end loop
mov x1,x4 // last index
mov x2,x5 // current index
bl exchange
mov x4,x5 // last index = current index
lsr x5,x5,#1 // current index / 2
b 2b
3: // store item at last index find
mov x6,#item_fin // item size
madd x6,x4,x6,x0 // item shift
add x6,x6,#heap_items // item address
str x8,[x6,#item_priority]
str x9,[x6,#item_address]
add x3,x3,#1 // increment heap size
cmp x3,#NBMAXIELEMENTS // maxi ?
bge 99f // yes -> error
str x3,[x0,#heap_size] // store new size
b 100f
99:
mov x0,#-1 // error
100:
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/******************************************************************/
/* swap two elements of table */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first index */
/* x2 contains the second index */
exchange:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
add x5,x0,#heap_items // address items begin
mov x3,#item_fin // item size
madd x4,x1,x3,x5 // compute item 1 address
madd x6,x2,x3,x5 // compute item 2 address
ldr x5,[x4,#item_priority] // exchange
ldr x3,[x6,#item_priority]
str x3,[x4,#item_priority]
str x5,[x6,#item_priority]
ldr x5,[x4,#item_address]
ldr x3,[x6,#item_address]
str x5,[x6,#item_address]
str x3,[x4,#item_address]
100:
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/******************************************************************/
/* move one element of table */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the origin index */
/* x2 contains the destination index */
moveItem:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
add x5,x0,#heap_items // address items begin
mov x3,#item_fin // item size
madd x4,x1,x3,x5 // compute item 1 address
madd x6,x2,x3,x5 // compute item 2 address
ldr x5,[x4,#item_priority] // exchange
str x5,[x6,#item_priority]
ldr x5,[x4,#item_address]
str x5,[x6,#item_address]
100:
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/******************************************************************/
/* pop queue */
/******************************************************************/
/* x0 contains the address of queue structure */
/* x0 return priority */
/* x1 return string address */
popQueue:
stp x10,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
mov x1,x0 // save address queue
bl isEmpty // control if empty queue
cmp x0,#1 // yes -> error
beq 99f
mov x0,x1 // restaur address queue
add x4,x0,#heap_items // address of item structure
ldr x8,[x4,#item_priority] // save priority first item
ldr x9,[x4,#item_address] // save address string first item
ldr x3,[x0,#heap_size] // heap size
sub x7,x3,#1 // last item
mov x1,x7
mov x2,#0 // first item
bl moveItem // move last item in first item
cmp x7,#1 // one only item ?
beq 10f // yes -> end
mov x4,#0 // first index
1:
cmp x4,x7 // = last index
bge 10f // yes -> end
mov x5,x7 // last index
cmp x4,#0 // init current index
mov x6,#1 // = 1
lsl x1,x4,#1 // else = first index * 2
csel x6,x6,x1,eq
cmp x6,x7 // current index > last index
bgt 2f // yes
// no compar priority current item last item
mov x1,#item_fin
madd x1,x6,x1,x0
add x1,x1,#heap_items // address of current item structure
ldr x1,[x1,#item_priority]
mov x10,#item_fin
madd x10,x5,x10,x0
add x10,x10,#heap_items // address of last item structure
ldr x10,[x10,#item_priority]
cmp x1,x10
csel x5,x6,x5,lt
2:
add x10,x6,#1 // increment current index
cmp x10,x7 // end ?
bgt 3f // yes
mov x1,#item_fin // no compare priority
madd x1,x10,x1,x0
add x1,x1,#heap_items // address of item structure
ldr x1,[x1,#item_priority]
mov x2,#item_fin
madd x2,x5,x2,x0
add x2,x2,#heap_items // address of item structure
ldr x2,[x2,#item_priority]
cmp x1,x2
csel x5,x10,x5,lt
3:
mov x1,x5 // move item
mov x2,x4
bl moveItem
mov x4,x5
b 1b // and loop
10:
sub x3,x3,#1
str x3,[x0,#heap_size] // new heap size
mov x0,x8 // return priority
mov x1,x9 // return string address
b 100f
99:
mov x0,#-1 // error
100:
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x10,lr,[sp],16 // restaur des 2 registres
ret
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"

View file

@ -0,0 +1,424 @@
/* ARM assembly Raspberry PI */
/* program priorqueue.s */
/* Constantes */
.equ STDOUT, 1 @ Linux output console
.equ EXIT, 1 @ Linux syscall
.equ WRITE, 4 @ Linux syscall
.equ NBMAXIELEMENTS, 100
/*******************************************/
/* Structures */
/********************************************/
/* example structure item */
.struct 0
item_priority: @ priority
.struct item_priority + 4
item_address: @ string address
.struct item_address + 4
item_fin:
/* example structure heap */
.struct 0
heap_size: @ heap size
.struct heap_size + 4
heap_items: @ structure of items
.struct heap_items + (item_fin * NBMAXIELEMENTS)
heap_fin:
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessEmpty: .asciz "Empty queue. \n"
szMessNotEmpty: .asciz "Not empty queue. \n"
szMessError: .asciz "Error detected !!!!. \n"
szMessResult: .ascii "Priority : " @ message result
sMessPriority: .fill 11, 1, ' '
.asciz " : "
szString1: .asciz "Clear drains"
szString2: .asciz "Feed cat"
szString3: .asciz "Make tea"
szString4: .asciz "Solve RC tasks"
szString5: .asciz "Tax return"
szCarriageReturn: .asciz "\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
.align 4
Queue1: .skip heap_fin @ queue memory place
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrQueue1 @ queue structure address
bl isEmpty
cmp r0,#0
beq 1f
ldr r0,iAdrszMessEmpty
bl affichageMess @ display message empty
b 2f
1:
ldr r0,iAdrszMessNotEmpty
bl affichageMess @ display message not empty
2:
@ init item 1
ldr r0,iAdrQueue1 @ queue structure address
mov r1,#3 @ priority
ldr r2,iAdrszString1
bl pushQueue @ add item in queue
cmp r0,#-1 @ error ?
beq 99f
ldr r0,iAdrQueue1 @ queue structure address
bl isEmpty
cmp r0,#0 @ not empty
beq 3f
ldr r0,iAdrszMessEmpty
bl affichageMess @ display message empty
b 4f
3:
ldr r0,iAdrszMessNotEmpty
bl affichageMess @ display message not empty
4:
@ init item 2
ldr r0,iAdrQueue1 @ queue structure address
mov r1,#4 @ priority
ldr r2,iAdrszString2
bl pushQueue @ add item in queue
cmp r0,#-1 @ error ?
beq 99f
@ init item 3
ldr r0,iAdrQueue1 @ queue structure address
mov r1,#5 @ priority
ldr r2,iAdrszString3
bl pushQueue @ add item in queue
cmp r0,#-1 @ error ?
beq 99f
@ init item 4
ldr r0,iAdrQueue1 @ queue structure address
mov r1,#1 @ priority
ldr r2,iAdrszString4
bl pushQueue @ add item in queue
cmp r0,#-1 @ error ?
beq 99f
@ init item 5
ldr r0,iAdrQueue1 @ queue structure address
mov r1,#2 @ priority
ldr r2,iAdrszString5
bl pushQueue @ add item in queue
cmp r0,#-1 @ error ?
beq 99f
5:
ldr r0,iAdrQueue1 @ queue structure address
bl popQueue @ return item
cmp r0,#-1 @ end ?
beq 100f
mov r2,r1 @ save string address
ldr r1,iAdrsMessPriority @ conversion priority
bl conversion10 @ decimal conversion
ldr r0,iAdrszMessResult
bl affichageMess @ display message
mov r0,r2 @ string address
bl affichageMess @ display message
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 5b @ loop
99:
@ error
ldr r0,iAdrszMessError
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrQueue1: .int Queue1
iAdrszString1: .int szString1
iAdrszString2: .int szString2
iAdrszString3: .int szString3
iAdrszString4: .int szString4
iAdrszString5: .int szString5
iAdrszMessError: .int szMessError
iAdrszMessEmpty: .int szMessEmpty
iAdrszMessNotEmpty: .int szMessNotEmpty
iAdrszMessResult: .int szMessResult
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessPriority: .int sMessPriority
/******************************************************************/
/* test if queue empty */
/******************************************************************/
/* r0 contains the address of queue structure */
isEmpty:
push {r1,lr} @ save registres
ldr r1,[r0,#heap_size] @ heap size
cmp r1,#0
moveq r0,#1 @ empty queue
movne r0,#0 @ not empty
pop {r1,lr} @ restaur registers
bx lr @ return
/******************************************************************/
/* add item in queue */
/******************************************************************/
/* r0 contains the address of queue structure */
/* r1 contains the priority of item */
/* r2 contains the string address */
pushQueue:
push {r1-r9,lr} @ save registres
ldr r3,[r0,#heap_size] @ heap size
cmp r3,#0 @ heap empty ?
bne 1f
add r4,r0,#heap_items @ address of item structure
str r1,[r4,#item_priority] @ store in first item
str r2,[r4,#item_address]
mov r3,#1 @ heap size
str r3,[r0,#heap_size] @ new heap size
b 100f
1:
mov r4,r3 @ maxi index
lsr r5,r4,#1 @ current index = maxi / 2
mov r8,r1 @ save priority
mov r9,r2 @ save string address
2: @ insertion loop
cmp r4,#0 @ end loop ?
ble 3f
mov r6,#item_fin @ item size
mul r6,r5,r6 @ item shift
add r6,r0
add r6,#heap_items @ compute address item
ldr r7,[r6,#item_priority] @ load priority
cmp r7,r8 @ compare priority
ble 3f @ <= end loop
mov r1,r4 @ last index
mov r2,r5 @ current index
bl exchange
mov r4,r5 @ last index = current index
lsr r5,#1 @ current index / 2
b 2b
3: @ store item at last index find
mov r6,#item_fin @ item size
mul r6,r4,r6 @ item shift
add r6,r0
add r6,#heap_items @ item address
str r8,[r6,#item_priority]
str r9,[r6,#item_address]
add r3,#1 @ increment heap size
cmp r3,#NBMAXIELEMENTS @ maxi ?
movge r0,#-1 @ yes -> error
bge 100f
str r3,[r0,#heap_size] @ store new size
100:
pop {r1-r9,lr} @ restaur registers
bx lr @ return
/******************************************************************/
/* swap two elements of table */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first index */
/* r2 contains the second index */
exchange:
push {r3-r6,lr} @ save registers
add r5,r0,#heap_items @ address items begin
mov r3,#item_fin @ item size
mul r4,r1,r3 @ compute item 1 shift
add r4,r5 @ compute item 1 address
mul r6,r2,r3 @ compute item 2 shift
add r6,r5 @ compute item 2 address
ldr r5,[r4,#item_priority] @ exchange
ldr r3,[r6,#item_priority]
str r3,[r4,#item_priority]
str r5,[r6,#item_priority]
ldr r5,[r4,#item_address]
ldr r3,[r6,#item_address]
str r5,[r6,#item_address]
str r3,[r4,#item_address]
100:
pop {r3-r6,lr}
bx lr @ return
/******************************************************************/
/* move one element of table */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the origin index */
/* r2 contains the destination index */
moveItem:
push {r3-r6,lr} @ save registers
add r5,r0,#heap_items @ address items begin
mov r3,#item_fin @ item size
mul r4,r1,r3 @ compute item 1 shift
add r4,r5 @ compute item 1 address
mul r6,r2,r3 @ compute item 2 shift
add r6,r5 @ compute item 2 address
ldr r5,[r4,#item_priority] @ exchange
str r5,[r6,#item_priority]
ldr r5,[r4,#item_address]
str r5,[r6,#item_address]
100:
pop {r3-r6,lr}
bx lr @ return
/******************************************************************/
/* pop queue */
/******************************************************************/
/* r0 contains the address of queue structure */
/* r0 return priority */
/* r1 return string address */
popQueue:
push {r2-r10,lr} @ save registres
mov r1,r0 @ save address queue
bl isEmpty @ control if empty queue
cmp r0,#1 @ yes -> error
moveq r0,#-1
beq 100f
@ save données à retourner
mov r0,r1 @ restaur address queue
add r4,r0,#heap_items @ address of item structure
ldr r8,[r4,#item_priority] @ save priority first item
ldr r9,[r4,#item_address] @ save address string first item
ldr r3,[r0,#heap_size] @ heap size
sub r7,r3,#1 @ last item
mov r1,r7
mov r2,#0 @ first item
bl moveItem @ move last item in first item
cmp r7,#1 @ one only item ?
beq 10f @ yes -> end
mov r4,#0 @ first index
1:
cmp r4,r7 @ = last index
bge 10f @ yes -> end
mov r5,r7 @ last index
cmp r4,#0 @ init current index
moveq r6,#1 @ = 1
lslne r6,r4,#1 @ else = first index * 2
cmp r6,r7 @ current index > last index
bgt 2f @ yes
@ no compar priority current item last item
mov r1,#item_fin
mul r1,r6,r1
add r1,r0
add r1,#heap_items @ address of current item structure
ldr r1,[r1,#item_priority]
mov r10,#item_fin
mul r10,r5,r10
add r10,r0
add r10,#heap_items @ address of last item structure
ldr r10,[r10,#item_priority]
cmp r1,r10
movlt r5,r6
2:
add r10,r6,#1 @ increment current index
cmp r10,r7 @ end ?
bgt 3f @ yes
mov r1,#item_fin @ no compare priority
mul r1,r10,r1
add r1,r0
add r1,#heap_items @ address of item structure
ldr r1,[r1,#item_priority]
mov r2,#item_fin
mul r2,r5,r2
add r2,r0
add r2,#heap_items @ address of item structure
ldr r2,[r2,#item_priority]
cmp r1,r2
movlt r5,r10
3:
mov r1,r5 @ move item
mov r2,r4
bl moveItem
mov r4,r5
b 1b @ and loop
10:
sub r3,#1
str r3,[r0,#heap_size] @ new heap size
mov r0,r8 @ return priority
mov r1,r9 @ return string address
100:
pop {r2-r10,lr} @ restaur registers
bx lr @ return
/******************************************************************/
/* display text with size calculation */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
push {r0,r1,r2,r7,lr} @ save registres
mov r2,#0 @ counter length
1: @ loop length calculation
ldrb r1,[r0,r2] @ read octet start position + index
cmp r1,#0 @ if 0 its over
addne r2,r2,#1 @ else add 1 in the length
bne 1b @ and loop
@ so here r2 contains the length of the message
mov r1,r0 @ address message in r1
mov r0,#STDOUT @ code to write to the standard output Linux
mov r7, #WRITE @ code call system "write"
svc #0 @ call systeme
pop {r0,r1,r2,r7,lr} @ restaur registers */
bx lr @ return
/******************************************************************/
/* Converting a register to a decimal */
/******************************************************************/
/* r0 contains value and r1 address area */
.equ LGZONECAL, 10
conversion10:
push {r1-r4,lr} @ save registers
mov r3,r1
mov r2,#LGZONECAL
1: @ start loop
bl divisionpar10 @ r0 <- dividende. quotient ->r0 reste -> r1
add r1,#48 @ digit
strb r1,[r3,r2] @ store digit on area
cmp r0,#0 @ stop if quotient = 0
subne r2,#1 @ previous position
bne 1b @ else loop
@ end replaces digit in front of area
mov r4,#0
2:
ldrb r1,[r3,r2]
strb r1,[r3,r4] @ store in area begin
add r4,#1
add r2,#1 @ previous position
cmp r2,#LGZONECAL @ end
ble 2b @ loop
mov r1,#' '
3:
strb r1,[r3,r4]
add r4,#1
cmp r4,#LGZONECAL @ end
ble 3b
100:
pop {r1-r4,lr} @ restaur registres
bx lr @return
/***************************************************/
/* division par 10 signé */
/* Thanks to http://thinkingeek.com/arm-assembler-raspberry-pi/*
/* and http://www.hackersdelight.org/ */
/***************************************************/
/* r0 dividende */
/* r0 quotient */
/* r1 remainder */
divisionpar10:
/* r0 contains the argument to be divided by 10 */
push {r2-r4} @ save registers */
mov r4,r0
mov r3,#0x6667 @ r3 <- magic_number lower
movt r3,#0x6666 @ r3 <- magic_number upper
smull r1, r2, r3, r0 @ r1 <- Lower32Bits(r1*r0). r2 <- Upper32Bits(r1*r0)
mov r2, r2, ASR #2 @ r2 <- r2 >> 2
mov r1, r0, LSR #31 @ r1 <- r0 >> 31
add r0, r2, r1 @ r0 <- r2 + r1
add r2,r0,r0, lsl #2 @ r2 <- r0 * 5
sub r1,r4,r2, lsl #1 @ r1 <- r4 - (r2 * 2) = r4 - (r0 * 10)
pop {r2-r4}
bx lr @ return

View file

@ -0,0 +1,290 @@
(* NOTE: Others are treating more negative numbers as the higher
priority, but I think it is pretty clear that making tea and
feeding the cat are higher in priority than solving RC tasks.
So I treat more positive numbers as higher priority.
But see a note below on how easy it is to reverse that. *)
#include "share/atspre_staload.hats"
staload UN = "prelude/SATS/unsafe.sats"
(* For the sake of the task, use a heap implementation that comes with
the ATS distribution. *)
staload H = "libats/ATS1/SATS/funheap_binomial.sats"
(* #include instead of anonymous staload, to work around an
inconvenience in the distributed code: funheap_is_empty and
funheap_isnot_empty are functions rather than template
functions. One could instead compile funheap_binomial.dats
separately. Or one could copy and modify the distributed code to
one's own taste. (The heap code is GPL-3+) *)
#include "libats/ATS1/DATS/funheap_binomial.dats"
#define NIL list_nil ()
#define :: list_cons
abstype pqueue (a : t@ype+) = ptr
extern fn {}
pqueue_make_empty :
{a : t@ype}
() -<> pqueue a
extern fn {}
pqueue_is_empty :
{a : t@ype}
pqueue (INV(a)) -<> [b : bool] bool
extern fn {}
pqueue_isnot_empty :
{a : t@ype}
pqueue (INV(a)) -<> [b : bool] bool
extern fn {a : t@ype}
pqueue_size :
pqueue (INV(a)) -<> [n : nat] size_t n
extern fn {a : t@ype}
pqueue_insert :
(&pqueue (INV(a)) >> _, int, a) -< !wrt > void
extern fn {a : t@ype}
pqueue_delete :
(&pqueue (INV(a)) >> _) -< !wrt > Option a
extern fn {a : t@ype}
pqueue_peek :
(pqueue (INV(a))) -< !wrt > Option a
extern fn {a : t@ype}
pqueue_merge :
(pqueue (INV(a)), pqueue a) -< !wrt > pqueue a
local
typedef heap_elt (a : t@ype+) =
'{
(* The "priority" field must come first. We take advantage of
the layout of a '{..} being that of a C struct. *)
priority = int,
value = a
}
fn {a : t@ype}
heap_elt_get_priority (elt : heap_elt a)
:<> int =
let
typedef prio_t = '{ priority = int }
val prio = $UN.cast{prio_t} elt
in
prio.priority
end
extern castfn
pqueue2heap :
{a : t@ype}
pqueue a -<> $H.heap (heap_elt a)
extern castfn
heap2pqueue :
{a : t@ype}
$H.heap (heap_elt a) -<> pqueue a
macdef p2h = pqueue2heap
macdef h2p = heap2pqueue
macdef comparison_cloref =
lam (x, y) =<cloref>
let
val px = heap_elt_get_priority x
and py = heap_elt_get_priority y
in
(* NOTE: Reverse the order of the arguments, if you want more
negative numbers to represent higher priorities. *)
compare (py, px)
end
fn {a : t@ype}
funheap_getmin_opt (heap : $H.heap (INV(a)),
cmp : $H.cmp a)
:<!wrt> Option_vt a =
let
var result : a?
val success = $H.funheap_getmin<a> (heap, cmp, result)
in
if success then
let
prval () = opt_unsome{a} result
in
Some_vt{a} result
end
else
let
prval () = opt_unnone{a} result
in
None_vt{a} ()
end
end
in
implement {}
pqueue_make_empty {a} () =
h2p{a} ($H.funheap_make_nil {heap_elt a} ())
implement {}
pqueue_is_empty {a} pq =
$H.funheap_is_empty {heap_elt a} (p2h{a} pq)
implement {}
pqueue_isnot_empty {a} pq =
$H.funheap_isnot_empty {heap_elt a} (p2h{a} pq)
implement {a}
pqueue_size pq =
$H.funheap_size<heap_elt a> (p2h{a} pq)
implement {a}
pqueue_insert (pq, priority, x) =
let
val elt =
'{
priority = priority,
value = x
} : heap_elt a
and compare = comparison_cloref
var heap = p2h{a} pq
val () = $H.funheap_insert (heap, elt, compare)
in
pq := h2p{a} heap
end
implement {a}
pqueue_delete pq =
let
typedef t = heap_elt a
val compare = comparison_cloref
var heap = p2h{a} pq
val elt_opt = $H.funheap_delmin_opt<heap_elt a> (heap, compare)
in
pq := h2p{a} heap;
case+ elt_opt of
| ~ Some_vt elt => Some (elt.value)
| ~ None_vt () => None ()
end
implement {a}
pqueue_peek pq =
let
typedef t = heap_elt a
val compare = comparison_cloref
and heap = p2h{a} pq
val elt_opt = funheap_getmin_opt<heap_elt a> (heap, compare)
in
case+ elt_opt of
| ~ Some_vt elt => Some (elt.value)
| ~ None_vt () => None ()
end
implement {a}
pqueue_merge (pq1, pq2) =
let
val heap1 = p2h{a} pq1
and heap2 = p2h{a} pq2
and compare = comparison_cloref
in
h2p{a} ($H.funheap_merge<heap_elt a> (heap1, heap2, compare))
end
overload iseqz with pqueue_is_empty
overload isneqz with pqueue_isnot_empty
overload size with pqueue_size
overload insert with pqueue_insert
overload delete with pqueue_delete
overload peek with pqueue_peek
overload merge with pqueue_merge
end
implement
main0 () =
let
var pq = pqueue_make_empty{string} ()
val () = print! (" ", iseqz pq)
val () = print! (" ", isneqz pq)
val () = print! (" ", "size:", size pq)
val () = insert (pq, 3, "3")
val () = insert (pq, 4, "4")
val () = insert (pq, 2, "2")
val () = insert (pq, 5, "5")
val () = insert (pq, 1, "1")
val () = print! (" ", iseqz pq)
val () = print! (" ", isneqz pq)
val () = print! (" ", "size:", size pq)
var pq2 = pqueue_make_empty{string} ()
val () = insert (pq, 6, "6")
val () = insert (pq, 4, "4a")
val () = pq := merge (pq, pq2)
val () = print! (" ", iseqz pq)
val () = print! (" ", isneqz pq)
val () = print! (" ", "size:", size pq)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = delete pq
val () = print! (" ", x)
val- Some x = delete pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = delete pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = peek pq
val () = print! (" ", x)
val- Some x = delete pq
val () = print! (" ", x)
val- Some x = delete pq
val () = print! (" ", x)
val- Some x = delete pq
val () = print! (" ", x)
val- Some x = delete pq
val () = print! (" ", x)
val- None () = delete pq
val () = println! ()
var pq2 = pqueue_make_empty{string} ()
val () = insert (pq2, 3, "Clear drains")
val () = insert (pq2, 4, "Feed cat")
val () = insert (pq2, 5, "Make tea")
val () = insert (pq2, 1, "Solve RC tasks")
val () = insert (pq2, 2, "Tax return")
val- Some x = delete pq2
val () = println! ("|", x, "|")
val- Some x = delete pq2
val () = println! ("|", x, "|")
val- Some x = delete pq2
val () = println! ("|", x, "|")
val- Some x = delete pq2
val () = println! ("|", x, "|")
val- Some x = delete pq2
val () = println! ("|", x, "|")
in
end

View file

@ -0,0 +1,106 @@
CARD EndProg ;required for ALLOCATE.ACT
INCLUDE "D2:ALLOCATE.ACT" ;from the Action! Tool Kit. You must type 'SET EndProg=*' from the monitor after compiling, but before running this program!
DEFINE PTR="CARD"
DEFINE NODE_SIZE="5"
TYPE QueueNode=[
BYTE priority
PTR data ;CHAR ARRAY
PTR nxt]
QueueNode POINTER queueFront,queueRear
BYTE FUNC IsEmpty()
IF queueFront=0 THEN
RETURN (1)
FI
RETURN (0)
PROC Push(BYTE p CHAR ARRAY d)
QueueNode POINTER node,curr,prev
node=Alloc(NODE_SIZE)
node.priority=p
node.data=d
node.nxt=0
IF IsEmpty() THEN
queueFront=node
queueRear=node
RETURN
FI
curr=queueFront
prev=0
WHILE curr#0 AND curr.priority<=p
DO
prev=curr
curr=curr.nxt
OD
IF prev=0 THEN
queueFront=node
ELSEIF curr=0 THEN
queueRear.nxt=node
queueRear=node
ELSE
prev.nxt=node
FI
node.nxt=curr
RETURN
PTR FUNC Pop()
QueueNode POINTER node
IF IsEmpty() THEN
PrintE("Error: queue is empty!")
Break()
FI
node=queueFront
queueFront=node.nxt
RETURN (node)
PROC TestIsEmpty()
IF IsEmpty() THEN
PrintE("Queue is empty")
ELSE
PrintE("Queue is not empty")
FI
RETURN
PROC TestPush(BYTE p CHAR ARRAY d)
PrintF("Push priority=%B task=%S%E",p,d)
Push(p,d)
RETURN
PROC TestPop()
QueueNode POINTER node
node=Pop()
PrintF("Pop priority=%B task=%S%E",node.priority,node.data)
Free(node,NODE_SIZE)
RETURN
PROC Main()
AllocInit(0)
queueFront=0
queueRear=0
Put(125) PutE() ;clear screen
TestIsEmpty()
TestPush(3,"Clear drains")
TestPush(4,"Feed cat")
TestPush(5,"Make tea")
TestPush(1,"Solve RC tasks")
TestPush(2,"Tax return")
TestIsEmpty()
TestPop()
TestPop()
TestPop()
TestPop()
TestPop()
TestIsEmpty()
RETURN

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;

View file

@ -0,0 +1,45 @@
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]

View file

@ -0,0 +1,60 @@
;-----------------------------------
PQ_TopItem(Queue,Task:=""){ ; remove and return top priority item
TopPriority := PQ_TopPriority(Queue)
for T, P in Queue
if (P = TopPriority) && ((T=Task)||!Task)
return T , Queue.Remove(T)
return 0
}
;-----------------------------------
PQ_AddTask(Queue,Task,Priority){ ; insert and return new task
for T, P in Queue
if (T=Task) || !(Priority && Task)
return 0
return Task, Queue[Task] := Priority
}
;-----------------------------------
PQ_DelTask(Queue, Task){ ; delete and return task
for T, P in Queue
if (T = Task)
return Task, Queue.Remove(Task)
}
;-----------------------------------
PQ_Peek(Queue){ ; peek and return top priority task(s)
TopPriority := PQ_TopPriority(Queue)
for T, P in Queue
if (P = TopPriority)
PeekList .= (PeekList?"`n":"") "`t" T
return PeekList
}
;-----------------------------------
PQ_Check(Queue,Task){ ; check task and return its priority
for T, P in Queue
if (T = Task)
return P
return 0
}
;-----------------------------------
PQ_Edit(Queue,Task,Priority){ ; Update task priority and return its new priority
for T, P in Queue
if (T = Task)
return Priority, Queue[T]:=Priority
return 0
}
;-----------------------------------
PQ_View(Queue){ ; view current Queue
for T, P in Queue
Res .= P " : " T "`n"
Sort, Res, FMySort
return "Priority Queue=`n" Res
}
MySort(a,b){
RegExMatch(a,"(\d+) : (.*)", x), RegExMatch(b,"(\d+) : (.*)", y)
return x1>y1?1:x1<y1?-1: x2>y2?1:x2<y2?-1: 0
}
;-----------------------------------
PQ_TopPriority(Queue){ ; return queue's top priority
for T, P in Queue
TopPriority := TopPriority?TopPriority:P , TopPriority := TopPriority<P?TopPriority:P
return, TopPriority
}

View file

@ -0,0 +1,22 @@
data =
(
3 Clear drains
1 test
4 Feed cat
5 Make tea
1 Solve RC tasks
2 Tax return
)
PQ:=[] ; Create Priority Queue PQ[Task, Priority]
loop, parse, data, `n, `r
F:= StrSplit(A_LoopField, "`t") , PQ[F[2]] := F[1]
PQ_View(PQ)
MsgBox, 262208,, % "Top Priority item(s)=`n" PQ_Peek(PQ) "`n`n" PQ_View(PQ)
MsgBox, 262208,, % "Add : " PQ_AddTask(PQ, "AutoHotkey", 2) "`n`n" PQ_View(PQ)
MsgBox, 262208,, % "Remove Top Item : " PQ_TopItem(PQ) "`n`n" PQ_View(PQ)
MsgBox, 262208,, % "Remove specific top item : " PQ_TopItem(PQ,"test") "`n`n" PQ_View(PQ)
MsgBox, 262208,, % "Delete Item : " PQ_DelTask(PQ, "Clear drains") "`n`n" PQ_View(PQ)
MsgBox, 262208,, % (Task:="Tax return") " new priority = " PQ_Edit(PQ,task, 7) "`n`n" PQ_View(PQ)
MsgBox, 262208,, % (Task:="Feed cat") " priority = " PQ_Check(PQ,task)"`n`n" PQ_View(PQ)
^Esc::
ExitApp

View file

@ -0,0 +1,27 @@
)abbrev Domain ORDKE OrderedKeyEntry
OrderedKeyEntry(Key:OrderedSet,Entry:SetCategory): Exports == Implementation where
Exports == OrderedSet with
construct: (Key,Entry) -> %
elt: (%,"key") -> Key
elt: (%,"entry") -> Entry
Implementation == add
Rep := Record(k:Key,e:Entry)
x,y: %
construct(a,b) == construct(a,b)$Rep @ %
elt(x,"key"):Key == (x@Rep).k
elt(x,"entry"):Entry == (x@Rep).e
x < y == x.key < y.key
x = y == x.key = y.key
hash x == hash(x.key)
if Entry has CoercibleTo OutputForm then
coerce(x):OutputForm == bracket [(x.key)::OutputForm,(x.entry)::OutputForm]
)abbrev Domain PRIORITY PriorityQueue
S ==> OrderedKeyEntry(Key,Entry)
PriorityQueue(Key:OrderedSet,Entry:SetCategory): Exports == Implementation where
Exports == PriorityQueueAggregate S with
heap : List S -> %
setelt: (%,Key,Entry) -> Entry
Implementation == Heap(S) add
setelt(x:%,key:Key,entry:Entry) ==
insert!(construct(key,entry)$S,x)
entry

View file

@ -0,0 +1,7 @@
pq := empty()$PriorityQueue(Integer,String)
pq(3):="Clear drains";
pq(4):="Feed cat";
pq(5):="Make tea";
pq(1):="Solve RC tasks";
pq(2):="Tax return";
[extract!(pq) for i in 1..#pq]

View file

@ -0,0 +1,29 @@
@echo off
setlocal enabledelayedexpansion
call :push 10 "item ten"
call :push 2 "item two"
call :push 100 "item one hundred"
call :push 5 "item five"
call :pop & echo !order! !item!
call :pop & echo !order! !item!
call :pop & echo !order! !item!
call :pop & echo !order! !item!
call :pop & echo !order! !item!
goto:eof
:push
set temp=000%1
set queu%temp:~-3%=%2
goto:eof
:pop
set queu >nul 2>nul
if %errorlevel% equ 1 (set order=-1&set item=no more items & goto:eof)
for /f "tokens=1,2 delims==" %%a in ('set queu') do set %%a=& set order=%%a& set item=%%~b& goto:next
:next
set order= %order:~-3%
goto:eof

View file

@ -0,0 +1,20 @@
#include <iostream>
#include <string>
#include <queue>
#include <utility>
int main() {
std::priority_queue<std::pair<int, std::string> > pq;
pq.push(std::make_pair(3, "Clear drains"));
pq.push(std::make_pair(4, "Feed cat"));
pq.push(std::make_pair(5, "Make tea"));
pq.push(std::make_pair(1, "Solve RC tasks"));
pq.push(std::make_pair(2, "Tax return"));
while (!pq.empty()) {
std::cout << pq.top().first << ", " << pq.top().second << std::endl;
pq.pop();
}
return 0;
}

View file

@ -0,0 +1,30 @@
#include <iostream>
#include <string>
#include <vector>
#include <algorithm>
#include <utility>
int main() {
std::vector<std::pair<int, std::string> > pq;
pq.push_back(std::make_pair(3, "Clear drains"));
pq.push_back(std::make_pair(4, "Feed cat"));
pq.push_back(std::make_pair(5, "Make tea"));
pq.push_back(std::make_pair(1, "Solve RC tasks"));
// heapify
std::make_heap(pq.begin(), pq.end());
// enqueue
pq.push_back(std::make_pair(2, "Tax return"));
std::push_heap(pq.begin(), pq.end());
while (!pq.empty()) {
// peek
std::cout << pq[0].first << ", " << pq[0].second << std::endl;
// dequeue
std::pop_heap(pq.begin(), pq.end());
pq.pop_back();
}
return 0;
}

View file

@ -0,0 +1,33 @@
using System;
using System.Collections.Generic;
namespace PriorityQueueExample
{
class Program
{
static void Main(string[] args)
{
// Starting with .NET 6.0 preview 2 (released March 11th, 2021), there's a built-in priority queue
var p = new PriorityQueue<string, int>();
p.Enqueue("Clear drains", 3);
p.Enqueue("Feed cat", 4);
p.Enqueue("Make tea", 5);
p.Enqueue("Solve RC tasks", 1);
p.Enqueue("Tax return", 2);
while (p.TryDequeue(out string task, out int priority))
{
Console.WriteLine($"{priority}\t{task}");
}
}
}
}
/* Output:
1 Solve RC tasks
2 Tax return
3 Clear drains
4 Feed cat
5 Make tea
*/

View file

@ -0,0 +1,60 @@
using System;
namespace PriorityQueue
{
class Program
{
static void Main(string[] args)
{
PriorityQueue PQ = new PriorityQueue();
PQ.push(3, "Clear drains");
PQ.push(4, "Feed cat");
PQ.push(5, "Make tea");
PQ.push(1, "Solve RC tasks");
PQ.push(2, "Tax return");
while (!PQ.Empty)
{
var Val = PQ.pop();
Console.WriteLine(Val[0] + " : " + Val[1]);
}
Console.ReadKey();
}
}
class PriorityQueue
{
private System.Collections.SortedList PseudoQueue;
public bool Empty
{
get
{
return PseudoQueue.Count == 0;
}
}
public PriorityQueue()
{
PseudoQueue = new System.Collections.SortedList();
}
public void push(object Priority, object Value)
{
PseudoQueue.Add(Priority, Value);
}
public object[] pop()
{
object[] ReturnValue = { null, null };
if (PseudoQueue.Count > 0)
{
ReturnValue[0] = PseudoQueue.GetKey(0);
ReturnValue[1] = PseudoQueue.GetByIndex(0);
PseudoQueue.RemoveAt(0);
}
return ReturnValue;
}
}
}

View file

@ -0,0 +1,121 @@
namespace PriorityQ {
using KeyT = UInt32;
using System;
using System.Collections.Generic;
using System.Linq;
class Tuple<K, V> { // for DotNet 3.5 without Tuple's
public K Item1; public V Item2;
public Tuple(K k, V v) { Item1 = k; Item2 = v; }
public override string ToString() {
return "(" + Item1.ToString() + ", " + Item2.ToString() + ")";
}
}
class MinHeapPQ<V> {
private struct HeapEntry {
public KeyT k; public V v;
public HeapEntry(KeyT k, V v) { this.k = k; this.v = v; }
}
private List<HeapEntry> pq;
private MinHeapPQ() { this.pq = new List<HeapEntry>(); }
private bool mt { get { return pq.Count == 0; } }
private int sz {
get {
var cnt = pq.Count;
return (cnt == 0) ? 0 : cnt - 1;
}
}
private Tuple<KeyT, V> pkmn {
get {
if (pq.Count == 0) return null;
else {
var mn = pq[0];
return new Tuple<KeyT, V>(mn.k, mn.v);
}
}
}
private void psh(KeyT k, V v) { // add extra very high item if none
if (pq.Count == 0) pq.Add(new HeapEntry(UInt32.MaxValue, v));
var i = pq.Count; pq.Add(pq[i - 1]); // copy bottom item...
for (var ni = i >> 1; ni > 0; i >>= 1, ni >>= 1) {
var t = pq[ni - 1];
if (t.k > k) pq[i - 1] = t; else break;
}
pq[i - 1] = new HeapEntry(k, v);
}
private void siftdown(KeyT k, V v, int ndx) {
var cnt = pq.Count - 1; var i = ndx;
for (var ni = i + i + 1; ni < cnt; ni = ni + ni + 1) {
var oi = i; var lk = pq[ni].k; var rk = pq[ni + 1].k;
var nk = k;
if (k > lk) { i = ni; nk = lk; }
if (nk > rk) { ni += 1; i = ni; }
if (i != oi) pq[oi] = pq[i]; else break;
}
pq[i] = new HeapEntry(k, v);
}
private void rplcmin(KeyT k, V v) {
if (pq.Count > 1) siftdown(k, v, 0);
}
private void dltmin() {
var lsti = pq.Count - 2;
if (lsti <= 0) pq.Clear();
else {
var lkv = pq[lsti];
pq.RemoveAt(lsti); siftdown(lkv.k, lkv.v, 0);
}
}
private void reheap(int i) {
var lfti = i + i + 1;
if (lfti < sz) {
var rghti = lfti + 1; reheap(lfti); reheap(rghti);
var ckv = pq[i]; siftdown(ckv.k, ckv.v, i);
}
}
private void bld(IEnumerable<Tuple<KeyT, V>> sq) {
var sqm = from e in sq
select new HeapEntry(e.Item1, e.Item2);
pq = sqm.ToList<HeapEntry>();
var sz = pq.Count;
if (sz > 0) {
var lkv = pq[sz - 1];
pq.Add(new HeapEntry(KeyT.MaxValue, lkv.v));
reheap(0);
}
}
private IEnumerable<Tuple<KeyT, V>> sq() {
return from e in pq
where e.k != KeyT.MaxValue
select new Tuple<KeyT, V>(e.k, e.v); }
private void adj(Func<KeyT, V, Tuple<KeyT, V>> f) {
var cnt = pq.Count - 1;
for (var i = 0; i < cnt; ++i) {
var e = pq[i];
var r = f(e.k, e.v);
pq[i] = new HeapEntry(r.Item1, r.Item2);
}
reheap(0);
}
public static MinHeapPQ<V> empty { get { return new MinHeapPQ<V>(); } }
public static bool isEmpty(MinHeapPQ<V> pq) { return pq.mt; }
public static int size(MinHeapPQ<V> pq) { return pq.sz; }
public static Tuple<KeyT, V> peekMin(MinHeapPQ<V> pq) { return pq.pkmn; }
public static MinHeapPQ<V> push(KeyT k, V v, MinHeapPQ<V> pq) {
pq.psh(k, v); return pq; }
public static MinHeapPQ<V> replaceMin(KeyT k, V v, MinHeapPQ<V> pq) {
pq.rplcmin(k, v); return pq; }
public static MinHeapPQ<V> deleteMin(MinHeapPQ<V> pq) { pq.dltmin(); return pq; }
public static MinHeapPQ<V> merge(MinHeapPQ<V> pq1, MinHeapPQ<V> pq2) {
return fromSeq(pq1.sq().Concat(pq2.sq())); }
public static MinHeapPQ<V> adjust(Func<KeyT, V, Tuple<KeyT, V>> f, MinHeapPQ<V> pq) {
pq.adj(f); return pq; }
public static MinHeapPQ<V> fromSeq(IEnumerable<Tuple<KeyT, V>> sq) {
var pq = new MinHeapPQ<V>(); pq.bld(sq); return pq; }
public static Tuple<Tuple<KeyT, V>, MinHeapPQ<V>> popMin(MinHeapPQ<V> pq) {
var rslt = pq.pkmn; if (rslt == null) return null;
pq.dltmin(); return new Tuple<Tuple<KeyT, V>, MinHeapPQ<V>>(rslt, pq); }
public static IEnumerable<Tuple<KeyT, V>> toSeq(MinHeapPQ<V> pq) {
for (; !pq.mt; pq.dltmin()) yield return pq.pkmn; }
public static IEnumerable<Tuple<KeyT, V>> sort(IEnumerable<Tuple<KeyT, V>> sq) {
return toSeq(fromSeq(sq)); }
}
}

View file

@ -0,0 +1,23 @@
static void Main(string[] args) {
Tuple<uint, string>[] ins = { new Tuple<uint,string>(3u, "Clear drains"),
new Tuple<uint,string>(4u, "Feed cat"),
new Tuple<uint,string>(5u, "Make tea"),
new Tuple<uint,string>(1u, "Solve RC tasks"),
new Tuple<uint,string>(2u, "Tax return") };
var spq = ins.Aggregate(MinHeapPQ<string>.empty, (pq, t) => MinHeapPQ<string>.push(t.Item1, t.Item2, pq));
foreach (var e in MinHeapPQ<string>.toSeq(spq)) Console.WriteLine(e); Console.WriteLine();
foreach (var e in MinHeapPQ<string>.sort(ins)) Console.WriteLine(e); Console.WriteLine();
var npq = MinHeapPQ<string>.fromSeq(ins);
foreach (var e in MinHeapPQ<string>.toSeq(MinHeapPQ<string>.merge(npq, npq)))
Console.WriteLine(e); Console.WriteLine();
var npq = MinHeapPQ<string>.fromSeq(ins);
foreach (var e in MinHeapPQ<string>.toSeq(MinHeapPQ<string>.merge(npq, npq)))
Console.WriteLine(e);
foreach (var e in MinHeapPQ<string>.toSeq(MinHeapPQ<string>.adjust((k, v) => new Tuple<uint,string>(6u - k, v), npq)))
Console.WriteLine(e); Console.WriteLine();
}

View file

@ -0,0 +1,71 @@
#include <stdio.h>
#include <stdlib.h>
typedef struct {
int priority;
char *data;
} node_t;
typedef struct {
node_t *nodes;
int len;
int size;
} heap_t;
void push (heap_t *h, int priority, char *data) {
if (h->len + 1 >= h->size) {
h->size = h->size ? h->size * 2 : 4;
h->nodes = (node_t *)realloc(h->nodes, h->size * sizeof (node_t));
}
int i = h->len + 1;
int j = i / 2;
while (i > 1 && h->nodes[j].priority > priority) {
h->nodes[i] = h->nodes[j];
i = j;
j = j / 2;
}
h->nodes[i].priority = priority;
h->nodes[i].data = data;
h->len++;
}
char *pop (heap_t *h) {
int i, j, k;
if (!h->len) {
return NULL;
}
char *data = h->nodes[1].data;
h->nodes[1] = h->nodes[h->len];
h->len--;
i = 1;
while (i!=h->len+1) {
k = h->len+1;
j = 2 * i;
if (j <= h->len && h->nodes[j].priority < h->nodes[k].priority) {
k = j;
}
if (j + 1 <= h->len && h->nodes[j + 1].priority < h->nodes[k].priority) {
k = j + 1;
}
h->nodes[i] = h->nodes[k];
i = k;
}
return data;
}
int main () {
heap_t *h = (heap_t *)calloc(1, sizeof (heap_t));
push(h, 3, "Clear drains");
push(h, 4, "Feed cat");
push(h, 5, "Make tea");
push(h, 1, "Solve RC tasks");
push(h, 2, "Tax return");
int i;
for (i = 0; i < 5; i++) {
printf("%s\n", pop(h));
}
return 0;
}

View file

@ -0,0 +1,18 @@
typedef struct _pq_node_t {
long int key;
struct _pq_node_t *next, *down;
} pq_node_t, *heap_t;
extern heap_t heap_merge(heap_t, heap_t);
extern heap_t heap_pop(heap_t);
#define NEW_PQ_ELE(p, k) \
do { \
(p) = (typeof(p)) malloc(sizeof(*p)); \
((pq_node_t *) (p))->next = ((pq_node_t *) (p))->down = NULL; \
((pq_node_t *) (p))->key = (k); \
} while (0)
#define HEAP_PUSH(p, k, h) \
NEW_PQ_ELE(p, k); \
*(h) = heap_merge(((pq_node_t *) (p)), *(h))

View file

@ -0,0 +1,44 @@
#include <stdlib.h>
#include "pairheap.h"
/* ---------------------------------------------------------------------------
* Pairing heap implementation
* --------------------------------------------------------------------------- */
static heap_t add_child(heap_t h, heap_t g) {
if (h->down != NULL)
g->next = h->down;
h->down = g;
}
heap_t heap_merge(heap_t a, heap_t b) {
if (a == NULL) return b;
if (b == NULL) return a;
if (a->key < b->key) {
add_child(a, b);
return a;
} else {
add_child(b, a);
return b;
}
}
/* NOTE: caller should have pointer to top of heap, since otherwise it won't
* be reclaimed. (we do not free the top.)
*/
heap_t two_pass_merge(heap_t h) {
if (h == NULL || h->next == NULL)
return h;
else {
pq_node_t
*a = h,
*b = h->next,
*rest = b->next;
a->next = b->next = NULL;
return heap_merge(heap_merge(a, b), two_pass_merge(rest));
}
}
heap_t heap_pop(heap_t h) {
return two_pass_merge(h->down);
}

View file

@ -0,0 +1,36 @@
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "pairheap.h"
struct task {
pq_node_t hd;
char task[40];
};
void main() {
heap_t heap = NULL;
struct task *new;
HEAP_PUSH(new, 3, &heap);
strcpy(new->task, "Clear drains.");
HEAP_PUSH(new, 4, &heap);
strcpy(new->task, "Feed cat.");
HEAP_PUSH(new, 5, &heap);
strcpy(new->task, "Make tea.");
HEAP_PUSH(new, 1, &heap);
strcpy(new->task, "Solve RC tasks.");
HEAP_PUSH(new, 2, &heap);
strcpy(new->task, "Tax return.");
while (heap != NULL) {
struct task *top = (struct task *) heap;
printf("%s\n", top->task);
heap = heap_pop(heap);
free(top);
}
}

View file

@ -0,0 +1,95 @@
prio_queue = cluster [P, T: type] is new, empty, push, pop
where P has lt: proctype (P,P) returns (bool)
item = struct[prio: P, val: T]
rep = array[item]
new = proc () returns (cvt)
return (rep$create(0))
end new
empty = proc (pq: cvt) returns (bool)
return (rep$empty(pq))
end empty
parent = proc (k: int) returns (int)
return ((k-1)/2)
end parent
left = proc (k: int) returns (int)
return (2*k + 1)
end left
right = proc (k: int) returns (int)
return (2*k + 2)
end right
swap = proc (pq: rep, a: int, b: int)
temp: item := pq[a]
pq[a] := pq[b]
pq[b] := temp
end swap
min_heapify = proc (pq: rep, k: int)
l: int := left(k)
r: int := right(k)
smallest: int := k
if l < rep$size(pq) cand pq[l].prio < pq[smallest].prio then
smallest := l
end
if r < rep$size(pq) cand pq[r].prio < pq[smallest].prio then
smallest := r
end
if smallest ~= k then
swap(pq, k, smallest)
min_heapify(pq, smallest)
end
end min_heapify
push = proc (pq: cvt, prio: P, val: T)
rep$addh(pq, item${prio: prio, val: val})
i: int := rep$high(pq)
while i ~= 0 cand pq[i].prio < pq[parent(i)].prio do
swap(pq, i, parent(i))
i := parent(i)
end
end push
pop = proc (pq: cvt) returns (P, T) signals (empty)
if empty(up(pq)) then signal empty end
if rep$size(pq) = 1 then
i: item := rep$remh(pq)
return (i.prio, i.val)
end
root: item := pq[0]
pq[0] := rep$remh(pq)
min_heapify(pq, 0)
return (root.prio, root.val)
end pop
end prio_queue
start_up = proc ()
% use ints for priority and strings for data
prioq = prio_queue[int,string]
% make the priority queue
pq: prioq := prioq$new()
% add some tasks
prioq$push(pq, 3, "Clear drains")
prioq$push(pq, 4, "Feed cat")
prioq$push(pq, 5, "Make tea")
prioq$push(pq, 1, "Solve RC tasks")
prioq$push(pq, 2, "Tax return")
% print them all out in order
po: stream := stream$primary_output()
while ~prioq$empty(pq) do
prio: int task: string
prio, task := prioq$pop(pq)
stream$putl(po, int$unparse(prio) || ": " || task)
end
end start_up

View file

@ -0,0 +1,19 @@
user=> (use 'clojure.data.priority-map)
; priority-map can be used as a priority queue
user=> (def p (priority-map "Clear drains" 3, "Feed cat" 4, "Make tea" 5, "Solve RC tasks" 1))
#'user/p
user=> p
{"Solve RC tasks" 1, "Clear drains" 3, "Feed cat" 4, "Make tea" 5}
; You can use assoc or conj to add items
user=> (assoc p "Tax return" 2)
{"Solve RC tasks" 1, "Tax return" 2, "Clear drains" 3, "Feed cat" 4, "Make tea" 5}
; peek to get first item, pop to give you back the priority-map with the first item removed
user=> (peek p)
["Solve RC tasks" 1]
; Merge priority-maps together
user=> (into p [["Wax Car" 4]["Paint Fence" 1]["Sand Floor" 3]])
{"Solve RC tasks" 1, "Paint Fence" 1, "Clear drains" 3, "Sand Floor" 3, "Wax Car" 4, "Feed cat" 4, "Make tea" 5}

View file

@ -0,0 +1,78 @@
PriorityQueue = ->
# Use closure style for object creation (so no "new" required).
# Private variables are toward top.
h = []
better = (a, b) ->
h[a].priority < h[b].priority
swap = (a, b) ->
[h[a], h[b]] = [h[b], h[a]]
sift_down = ->
max = h.length
n = 0
while n < max
c1 = 2*n + 1
c2 = c1 + 1
best = n
best = c1 if c1 < max and better(c1, best)
best = c2 if c2 < max and better(c2, best)
return if best == n
swap n, best
n = best
sift_up = ->
n = h.length - 1
while n > 0
parent = Math.floor((n-1) / 2)
return if better parent, n
swap n, parent
n = parent
# now return the public interface, which is an object that only
# has functions on it
self =
size: ->
h.length
push: (priority, value) ->
elem =
priority: priority
value: value
h.push elem
sift_up()
pop: ->
throw Error("cannot pop from empty queue") if h.length == 0
value = h[0].value
last = h.pop()
if h.length > 0
h[0] = last
sift_down()
value
# test
do ->
pq = PriorityQueue()
pq.push 3, "Clear drains"
pq.push 4, "Feed cat"
pq.push 5, "Make tea"
pq.push 1, "Solve RC tasks"
pq.push 2, "Tax return"
while pq.size() > 0
console.log pq.pop()
# test high performance
for n in [1..100000]
priority = Math.random()
pq.push priority, priority
v = pq.pop()
console.log "First random element was #{v}"
while pq.size() > 0
new_v = pq.pop()
throw Error "Queue broken" if new_v < v
v = new_v
console.log "Final random element was #{v}"

View file

@ -0,0 +1,8 @@
> coffee priority_queue.coffee
Solve RC tasks
Tax return
Clear drains
Feed cat
Make tea
First random element was 0.00002744467929005623
Final random element was 0.9999718656763434

View file

@ -0,0 +1,32 @@
;priority-queue's are implemented with association lists
(defun make-pq (alist)
(sort (copy-alist alist) (lambda (a b) (< (car a) (car b)))))
;
;Will change the state of pq
;
(define-modify-macro insert-pq (pair)
(lambda (pq pair) (sort-alist (cons pair pq))))
(define-modify-macro remove-pq-aux () cdr)
(defmacro remove-pq (pq)
`(let ((aux (copy-alist ,pq)))
(REMOVE-PQ-AUX ,pq)
(car aux)))
;
;Will not change the state of pq
;
(defun insert-pq-non-destructive (pair pq)
(sort-alist (cons pair pq)))
(defun remove-pq-non-destructive (pq)
(cdr pq))
;testing
(defparameter a (make-pq '((1 . "Solve RC tasks") (3 . "Clear drains") (2 . "Tax return") (5 . "Make tea"))))
(format t "~a~&" a)
(insert-pq a '(4 . "Feed cat"))
(format t "~a~&" a)
(format t "~a~&" (remove-pq a))
(format t "~a~&" a)
(format t "~a~&" (remove-pq a))
(format t "~a~&" a)

View file

@ -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.

View file

@ -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.

View file

@ -0,0 +1,15 @@
import std.stdio, std.container, std.array, std.typecons;
void main() {
alias tuple T;
auto heap = heapify([T(3, "Clear drains"),
T(4, "Feed cat"),
T(5, "Make tea"),
T(1, "Solve RC tasks"),
T(2, "Tax return")]);
while (!heap.empty) {
writeln(heap.front);
heap.removeFront();
}
}

View file

@ -0,0 +1,18 @@
program Priority_queue;
{$APPTYPE CONSOLE}
uses
System.SysUtils, Boost.Generics.Collection;
var
Queue: TPriorityQueue<String>;
begin
Queue := TPriorityQueue<String>.Create(['Clear drains', 'Feed cat',
'Make tea', 'Solve RC tasks', 'Tax return'], [3, 4, 5, 1, 2]);
while not Queue.IsEmpty do
with Queue.DequeueEx do
Writeln(Priority, ', ', value);
end.

View file

@ -0,0 +1,18 @@
(lib 'tree)
(define tasks (make-bin-tree 3 "Clear drains"))
(bin-tree-insert tasks 2 "Tax return")
(bin-tree-insert tasks 5 "Make tea")
(bin-tree-insert tasks 1 "Solve RC tasks")
(bin-tree-insert tasks 4 "Feed 🐡")
(bin-tree-pop-first tasks) → (1 . "Solve RC tasks")
(bin-tree-pop-first tasks) → (2 . "Tax return")
(bin-tree-pop-first tasks) → (3 . "Clear drains")
(bin-tree-pop-first tasks) → (4 . "Feed 🐡")
(bin-tree-pop-first tasks) → (5 . "Make tea")
(bin-tree-pop-first tasks) → null
;; similarly
(bin-tree-pop-last tasks) → (5 . "Make tea")
(bin-tree-pop-last tasks) → (4 . "Feed 🐡")
; etc.

View file

@ -0,0 +1,30 @@
defmodule Priority do
def create, do: :gb_trees.empty
def insert( element, priority, queue ), do: :gb_trees.enter( priority, element, queue )
def peek( queue ) do
{_priority, element, _new_queue} = :gb_trees.take_smallest( queue )
element
end
def task do
items = [{3, "Clear drains"}, {4, "Feed cat"}, {5, "Make tea"}, {1, "Solve RC tasks"}, {2, "Tax return"}]
queue = Enum.reduce(items, create, fn({priority, element}, acc) -> insert( element, priority, acc ) end)
IO.puts "peek priority: #{peek( queue )}"
Enum.reduce(1..length(items), queue, fn(_n, q) -> write_top( q ) end)
end
def top( queue ) do
{_priority, element, new_queue} = :gb_trees.take_smallest( queue )
{element, new_queue}
end
defp write_top( q ) do
{element, new_queue} = top( q )
IO.puts "top priority: #{element}"
new_queue
end
end
Priority.task

View file

@ -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.

View file

@ -0,0 +1,103 @@
[<RequireQualifiedAccess>]
module PriorityQ =
// type 'a treeElement = Element of uint32 * 'a
type 'a treeElement = struct val k:uint32 val v:'a new(k,v) = { k=k;v=v } end
type 'a tree = Node of uint32 * 'a treeElement * 'a tree list
type 'a heap = 'a tree list
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
[<NoEquality; NoComparison>]
type 'a outerheap = | HeapEmpty | HeapNotEmpty of 'a treeElement * 'a heap
let empty = HeapEmpty
let isEmpty = function | HeapEmpty -> true | _ -> false
let inline private rank (Node(r,_,_)) = r
let inline private root (Node(_,x,_)) = x
exception Empty_Heap
let peekMin = function | HeapEmpty -> None
| HeapNotEmpty(min, _) -> Some (min.k, min.v)
let rec private findMin heap =
match heap with | [] -> raise Empty_Heap //guarded so should never happen
| [node] -> root node,[]
| topnode::heap' ->
let min,subheap = findMin heap' in let rtn = root topnode
match subheap with
| [] -> if rtn.k > min.k then min,[] else rtn,[]
| minnode::heap'' ->
let rmn = root minnode
if rtn.k <= rmn.k then rtn,heap
else rmn,minnode::topnode::heap''
let private mergeTree (Node(r,kv1,ts1) as tree1) (Node (_,kv2,ts2) as tree2) =
if kv1.k > kv2.k then Node(r+1u,kv2,tree1::ts2)
else Node(r+1u,kv1,tree2::ts1)
let rec private insTree (newnode: 'a tree) heap =
match heap with
| [] -> [newnode]
| topnode::heap' -> if (rank newnode) < (rank topnode) then newnode::heap
else insTree (mergeTree newnode topnode) heap'
let push k v = let kv = treeElement(k,v) in let nn = Node(0u,kv,[])
function | HeapEmpty -> HeapNotEmpty(kv,[nn])
| HeapNotEmpty(min,heap) -> let nmin = if k > min.k then min else kv
HeapNotEmpty(nmin,insTree nn heap)
let rec private merge' heap1 heap2 = //doesn't guaranty minimum tree node as head!!!
match heap1,heap2 with
| _,[] -> heap1
| [],_ -> heap2
| topheap1::heap1',topheap2::heap2' ->
match compare (rank topheap1) (rank topheap2) with
| -1 -> topheap1::merge' heap1' heap2
| 1 -> topheap2::merge' heap1 heap2'
| _ -> insTree (mergeTree topheap1 topheap2) (merge' heap1' heap2')
let merge oheap1 oheap2 = match oheap1,oheap2 with
| _,HeapEmpty -> oheap1
| HeapEmpty,_ -> oheap2
| HeapNotEmpty(min1,heap1),HeapNotEmpty(min2,heap2) ->
let min = if min1.k > min2.k then min2 else min1
HeapNotEmpty(min,merge' heap1 heap2)
let rec private removeMinTree = function
| [] -> raise Empty_Heap // will never happen as already guarded
| [node] -> node,[]
| t::ts -> let t',ts' = removeMinTree ts
if (root t).k <= (root t').k then t,ts else t',t::ts'
let deleteMin =
function | HeapEmpty -> HeapEmpty
| HeapNotEmpty(_,heap) ->
match heap with
| [] -> HeapEmpty // should never occur: non empty heap with no elements
| [Node(_,_,heap')] -> match heap' with
| [] -> HeapEmpty
| _ -> let min,_ = findMin heap'
HeapNotEmpty(min,heap')
| _::_ -> let Node(_,_,ts1),ts2 = removeMinTree heap
let nheap = merge' (List.rev ts1) ts2 in let min,_ = findMin nheap
HeapNotEmpty(min,nheap)
let replaceMin k v pq = push k v (deleteMin pq)
let fromSeq sq = Seq.fold (fun pq (k, v) -> push k v pq) empty sq
let popMin pq = match peekMin pq with
| None -> None
| Some(kv) -> Some(kv, deleteMin pq)
let toSeq pq = Seq.unfold popMin pq
let sort sq = sq |> fromSeq |> toSeq
let adjust f pq = pq |> toSeq |> Seq.map (fun (k, v) -> f k v) |> fromSeq

View file

@ -0,0 +1,133 @@
[<RequireQualifiedAccess>]
module PriorityQ =
type HeapEntry<'V> = struct val k:uint32 val v:'V new(k,v) = {k=k;v=v} end
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
[<NoEquality; NoComparison>]
type PQ<'V> =
| Mt
| Br of HeapEntry<'V> * PQ<'V> * PQ<'V>
let empty = Mt
let isEmpty = function | Mt -> true
| _ -> false
// Return number of elements in the priority queue.
// /O(log(n)^2)/
let rec size = function
| Mt -> 0
| Br(_, ll, rr) ->
let n = size rr
// rest n p q, where n = size ll, and size ll - size rr = 0 or 1
// returns 1 + size ll - size rr.
let rec rest n pl pr =
match pl with
| Mt -> 1
| Br(_, pll, plr) ->
match pr with
| Mt -> 2
| Br(_, prl, prr) ->
let nm1 = n - 1 in let d = nm1 >>> 1
if (nm1 &&& 1) = 0
then rest d pll prl // subtree sizes: (d or d+1), d; d, d
else rest d plr prr // subtree sizes: d+1, (d or d+1); d+1, d
2 * n + rest n ll rr
let peekMin = function | Br(kv, _, _) -> Some(kv.k, kv.v)
| _ -> None
let rec push wk wv =
function | Mt -> Br(HeapEntry(wk, wv), Mt, Mt)
| Br(vkv, ll, rr) ->
if wk <= vkv.k then
Br(HeapEntry(wk, wv), push vkv.k vkv.v rr, ll)
else Br(vkv, push wk wv rr, ll)
let inline private siftdown wk wv pql pqr =
let rec sift pl pr =
match pl with
| Mt -> Br(HeapEntry(wk, wv), Mt, Mt)
| Br(vkvl, pll, plr) ->
match pr with
| Mt -> if wk <= vkvl.k then Br(HeapEntry(wk, wv), pl, Mt)
else Br(vkvl, Br(HeapEntry(wk, wv), Mt, Mt), Mt)
| Br(vkvr, prl, prr) ->
if wk <= vkvl.k && wk <= vkvr.k then Br(HeapEntry(wk, wv), pl, pr)
elif vkvl.k <= vkvr.k then Br(vkvl, sift pll plr, pr)
else Br(vkvr, pl, sift prl prr)
sift pql pqr
let replaceMin wk wv = function | Mt -> Mt
| Br(_, ll, rr) -> siftdown wk wv ll rr
let deleteMin = function
| Mt -> Mt
| Br(_, ll, Mt) -> ll
| Br(vkv, ll, rr) ->
let rec leftrem = function | Mt -> vkv, Mt // should never happen
| Br(kvd, Mt, _) -> kvd, Mt
| Br(vkv, Br(kvd, _, _), Mt) ->
kvd, Br(vkv, Mt, Mt)
| Br(vkv, pl, pr) -> let kvd, pqd = leftrem pl
kvd, Br(vkv, pr, pqd)
let (kvd, pqd) = leftrem ll
siftdown kvd.k kvd.v rr pqd;
let adjust f pq =
let rec adj = function
| Mt -> Mt
| Br(vkv, ll, rr) -> let nk, nv = f vkv.k vkv.v
siftdown nk nv (adj ll) (adj rr)
adj pq
let fromSeq sq =
if Seq.isEmpty sq then Mt
else let nmrtr = sq.GetEnumerator()
let rec build lvl = if lvl = 0 || not (nmrtr.MoveNext()) then Mt
else let ck, cv = nmrtr.Current
let lft = lvl >>> 1
let rght = (lvl - 1) >>> 1
siftdown ck cv (build lft) (build rght)
build (sq |> Seq.length)
let merge (pq1:PQ<_>) (pq2:PQ<_>) = // merges without using a sequence
match pq1 with
| Mt -> pq2
| _ ->
match pq2 with
| Mt -> pq1
| _ ->
let rec zipper lvl pq rest =
if lvl = 0 then Mt, pq, rest else
let lft = lvl >>> 1 in let rght = (lvl - 1) >>> 1
match pq with
| Mt ->
match rest with
| [] | Mt :: _ -> Mt, pq, [] // Mt in list never happens
| Br(kv, ll, Mt) :: tl ->
let pl, pql, rstl = zipper lft ll tl
let pr, pqr, rstr = zipper rght pql rstl
siftdown kv.k kv.v pl pr, pqr, rstr
| Br(kv, ll, rr) :: tl ->
let pl, pql, rstl = zipper lft ll (rr :: tl)
let pr, pqr, rstr = zipper rght pql rstl
siftdown kv.k kv.v pl pr, pqr, rstr
| Br(kv, ll, Mt) ->
let pl, pql, rstl = zipper lft ll rest
let pr, pqr, rstr = zipper rght pql rstl
siftdown kv.k kv.v pl pr, pqr, rstr
| Br(kv, ll, rr) ->
let pl, pql, rstl = zipper lft ll (rr :: rest)
let pr, pqr, rstr = zipper rght pql rstl
siftdown kv.k kv.v pl pr, pqr, rstr
let sz = size pq1 + size pq2
let pq, _, _ = zipper sz pq1 [pq2] in pq
let popMin pq = match peekMin pq with
| None -> None
| Some(kv) -> Some(kv, deleteMin pq)
let toSeq pq = Seq.unfold popMin pq
let sort sq = sq |> fromSeq |> toSeq

View file

@ -0,0 +1,84 @@
[<RequireQualifiedAccess>]
module PriorityQ =
type HeapEntry<'T> = struct val k:uint32 val v:'T new(k,v) = { k=k;v=v } end
type MinHeapTree<'T> = ResizeArray<HeapEntry<'T>>
let empty<'T> = MinHeapTree<HeapEntry<'T>>()
let isEmpty (pq: MinHeapTree<_>) = pq.Count = 0
let size (pq: MinHeapTree<_>) = let cnt = pq.Count
if cnt = 0 then 0 else cnt - 1
let peekMin (pq:MinHeapTree<_>) = if pq.Count > 1 then let kv = pq.[0]
Some (kv.k, kv.v) else None
let push k v (pq:MinHeapTree<_>) =
if pq.Count = 0 then pq.Add(HeapEntry(0xFFFFFFFFu,v)) //add an extra entry so there's always a right max node
let mutable nxtlvl = pq.Count in let mutable lvl = nxtlvl <<< 1 //1 past index of value added times 2
pq.Add(pq.[nxtlvl - 1]) //copy bottom entry then do bubble up while less than next level up
while ((lvl <- lvl >>> 1); nxtlvl <- nxtlvl >>> 1; nxtlvl <> 0) do
let t = pq.[nxtlvl - 1] in if t.k > k then pq.[lvl - 1] <- t else lvl <- lvl <<< 1; nxtlvl <- 0 //causes loop break
pq.[lvl - 1] <- HeapEntry(k,v); pq
let inline private siftdown k v ndx (pq: MinHeapTree<_>) =
let mutable i = ndx in let mutable ni = i in let cnt = pq.Count - 1
while (ni <- ni + ni + 1; ni < cnt) do
let lk = pq.[ni].k in let rk = pq.[ni + 1].k in let oi = i
let k = if k > lk then i <- ni; lk else k in if k > rk then ni <- ni + 1; i <- ni
if i <> oi then pq.[oi] <- pq.[i] else ni <- cnt //causes loop break
pq.[i] <- HeapEntry(k,v)
let replaceMin k v (pq:MinHeapTree<_>) = siftdown k v 0 pq; pq
let deleteMin (pq:MinHeapTree<_>) =
let lsti = pq.Count - 2
if lsti <= 0 then pq.Clear(); pq else
let lstkv = pq.[lsti]
pq.RemoveAt(lsti)
siftdown lstkv.k lstkv.v 0 pq; pq
let adjust f (pq:MinHeapTree<_>) = //adjust all the contents using the function, then re-heapify
let cnt = pq.Count - 1
let rec adj i =
let lefti = i + i + 1 in let righti = lefti + 1
let ckv = pq.[i] in let (nk, nv) = f ckv.k ckv.v
if righti < cnt then adj righti
if lefti < cnt then adj lefti; siftdown nk nv i pq
else pq.[i] <- HeapEntry(nk, nv)
adj 0; pq
let fromSeq sq =
if Seq.isEmpty sq then empty
else let pq = new MinHeapTree<_>(sq |> Seq.map (fun (k, v) -> HeapEntry(k, v)))
let sz = pq.Count in let lkv = pq.[sz - 1]
pq.Add(HeapEntry(UInt32.MaxValue, lkv.v))
let rec build i =
let lefti = i + i + 1
if lefti < sz then
let righti = lefti + 1 in build lefti; build righti
let ckv = pq.[i] in siftdown ckv.k ckv.v i pq
build 0; pq
let merge (pq1:MinHeapTree<_>) (pq2:MinHeapTree<_>) =
if pq2.Count = 0 then pq1 else
if pq1.Count = 0 then pq2 else
let pq = empty
pq.AddRange(pq1); pq.RemoveAt(pq.Count - 1)
pq.AddRange(pq2)
let sz = pq.Count - 1
let rec build i =
let lefti = i + i + 1
if lefti < sz then
let righti = lefti + 1 in build lefti; build righti
let ckv = pq.[i] in siftdown ckv.k ckv.v i pq
build 0; pq
let popMin pq = match peekMin pq with
| None -> None
| Some(kv) -> Some(kv, deleteMin pq)
let toSeq pq = Seq.unfold popMin pq
let sort sq = sq |> fromSeq |> toSeq

View file

@ -0,0 +1,19 @@
> let testseq = [| (3u, "Clear drains");
(4u, "Feed cat");
(5u, "Make tea");
(1u, "Solve RC tasks");
(2u, "Tax return") |] |> Array.toSeq
let testpq = testseq |> MinHeap.fromSeq
testseq |> Seq.fold (fun pq (k, v) -> MinHeap.push k v pq) MinHeap.empty
|> MinHeap.toSeq |> Seq.iter (printfn "%A") // test slow build
printfn ""
testseq |> MinHeap.fromSeq |> MinHeap.toSeq // test fast build
|> Seq.iter (printfn "%A")
printfn ""
testseq |> MinHeap.sort |> Seq.iter (printfn "%A") // convenience function
printfn ""
MinHeap.merge testpq testpq // test merge
|> MinHeap.toSeq |> Seq.iter (printfn "%A")
printfn ""
testpq |> MinHeap.adjust (fun k v -> uint32 (MinHeap.size testpq) - k, v)
|> MinHeap.toSeq |> Seq.iter (printfn "%A") // test adjust;;

View file

@ -0,0 +1,10 @@
<min-heap> [ {
{ 3 "Clear drains" }
{ 4 "Feed cat" }
{ 5 "Make tea" }
{ 1 "Solve RC tasks" }
{ 2 "Tax return" }
} swap heap-push-all
] [
[ print ] slurp-heap
] bi

View file

@ -0,0 +1,5 @@
Solve RC tasks
Tax return
Clear drains
Feed cat
Make tea

View file

@ -0,0 +1,185 @@
#! /usr/bin/gforth
\ Priority queue
10 CONSTANT INITIAL-CAPACITY
\ creates a new empty queue
: new-queue ( -- addr )
2 INITIAL-CAPACITY 3 * + cells allocate throw
INITIAL-CAPACITY over !
0 over cell + !
;
\ deletes a queue
: delete-queue ( addr -- )
free throw
;
: queue-capacity ( addr -- n )
@
;
\ the number of elements in the queue
: queue-size ( addr -- n )
cell + @
;
: resize-queue ( addr -- addr )
dup queue-capacity 2 * dup >r 3 * 2 + cells resize throw
r> over !
;
: ix->addr ( addr ix -- addr )
3 * 2 + cells +
;
: ix! ( p x y addr ix -- )
ix->addr
tuck 2 cells + !
tuck cell + !
!
;
: ix@ ( addr ix -- p x y )
ix->addr
dup @ swap
cell + dup @ swap
cell + @
;
: ix->priority ( addr ix -- p )
ix->addr @
;
: ix<->ix ( addr ix ix' -- )
-rot over swap ( ix' addr addr ix ) ( )
2over swap 2>r ( ix' addr addr ix ) ( addr ix' )
2dup ix@ 2>r >r ( ix' addr addr ix ) ( addr ix' x y p )
2>r ( ix' addr ) ( addr ix' x y p addr ix )
swap ix@ ( p' x' y' ) ( addr ix' x y p addr ix )
2r> ix! ( ) ( addr ix' x y p )
r> 2r> 2r> ix! ( ) ( )
;
: ix-parent ( ix -- ix' )
dup 0> IF
1- 2/
THEN
;
: ix-left-son ( ix -- ix' )
2* 1+
;
: ix-right-son ( ix -- ix' )
2* 2 +
;
: swap? ( addr ix ix' -- f )
rot >r ( ix ix' ) ( addr )
2dup ( ix ix' ix ix' ) ( addr )
r> tuck swap ( ix ix' ix addr addr ix' ) ( )
ix->priority >r ( ix ix' ix addr ) ( p' )
tuck swap ( ix ix' addr addr ix ) ( p' )
ix->priority r> ( ix ix' addr p p' ) ( )
> IF
-rot ix<->ix
true
ELSE
2drop drop
false
THEN
;
: ix? ( addr ix -- f )
swap queue-size <
;
: bubble-up ( addr ix -- )
2dup dup ix-parent swap ( addr ix addr ix' ix )
swap? IF ( addr ix )
ix-parent recurse
ELSE
2drop
THEN
;
: bubble-down ( addr ix -- )
2dup ix-right-son ix? IF
2dup ix-left-son ix->priority >r
2dup ix-right-son ix->priority r> < IF
2dup dup ix-right-son swap? IF
ix-right-son recurse
ELSE
2drop
THEN
ELSE
2dup dup ix-left-son swap? IF
ix-left-son recurse
ELSE
2drop
THEN
THEN
ELSE
2dup ix-left-son ix? IF
2dup dup ix-left-son swap? IF
ix-left-son recurse
ELSE
2drop
THEN
ELSE
2drop
THEN
THEN
;
\ enqueues an element with priority p and payload x y into queue addr
: >queue ( p x y addr -- addr )
dup queue-capacity over queue-size =
IF
resize-queue
THEN
dup >r
dup queue-size
ix!
r>
1 over cell + +!
dup dup queue-size 1- bubble-up
;
\ dequeues the element with highest priority
: queue> ( addr -- p x y )
dup queue-size 0= IF
1 throw
THEN
dup 0 ix@ 2>r >r dup >r
dup dup queue-size 1- ix@ r> 0 ix!
dup cell + -1 swap +!
0 bubble-down
r> 2r>
;
\ dequeues elements and prints them until the queue is empty
: drain-queue ( addr -- )
dup queue-size 0> IF
dup queue>
rot
. ." - " type cr
recurse
ELSE
drop
THEN
;
\ example
new-queue
>r 3 s" Clear drains" r> >queue
>r 4 s" Feed cat" r> >queue
>r 5 s" Make tea" r> >queue
>r 1 s" Solve RC tasks" r> >queue
>r 2 s" Tax return" r> >queue
drain-queue

View file

@ -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

View file

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

View file

@ -0,0 +1,10 @@
pq = newJava["java.util.PriorityQueue", new Comparator[byColumn[0]]]
pq.add[[3, "Clear Drains"]]
pq.add[[4, "Feed cat"]]
pq.add[[5, "Make tea"]]
pq.add[[1, "Solve RC tasks"]]
pq.add[[2, "Tax return"]]
while ! pq.isEmpty[]
println[pq.poll[]]

View file

@ -0,0 +1,22 @@
import util.ordering
native scala.collection.mutable.PriorityQueue
data Task( priority, description )
def comparator( Task(a, _), Task(b, _) )
| a > b = -1
| a < b = 1
| otherwise = 0
q = PriorityQueue( ordering(comparator) )
q.enqueue(
Task(3, 'Clear drains'),
Task(4, 'Feed cat'),
Task(5, 'Make tea'),
Task(1, 'Solve RC tasks'),
Task(2, 'Tax return')
)
while not q.isEmpty()
println( q.dequeue() )

View file

@ -0,0 +1,43 @@
package main
import (
"fmt"
"container/heap"
)
type Task struct {
priority int
name string
}
type TaskPQ []Task
func (self TaskPQ) Len() int { return len(self) }
func (self TaskPQ) Less(i, j int) bool {
return self[i].priority < self[j].priority
}
func (self TaskPQ) Swap(i, j int) { self[i], self[j] = self[j], self[i] }
func (self *TaskPQ) Push(x interface{}) { *self = append(*self, x.(Task)) }
func (self *TaskPQ) Pop() (popped interface{}) {
popped = (*self)[len(*self)-1]
*self = (*self)[:len(*self)-1]
return
}
func main() {
pq := &TaskPQ{{3, "Clear drains"},
{4, "Feed cat"},
{5, "Make tea"},
{1, "Solve RC tasks"}}
// heapify
heap.Init(pq)
// enqueue
heap.Push(pq, Task{2, "Tax return"})
for pq.Len() != 0 {
// dequeue
fmt.Println(heap.Pop(pq))
}
}

View file

@ -0,0 +1,18 @@
import groovy.transform.Canonical
@Canonical
class Task implements Comparable<Task> {
int priority
String name
int compareTo(Task o) { priority <=> o?.priority }
}
new PriorityQueue<Task>().with {
add new Task(priority: 3, name: 'Clear drains')
add new Task(priority: 4, name: 'Feed cat')
add new Task(priority: 5, name: 'Make tea')
add new Task(priority: 1, name: 'Solve RC tasks')
add new Task(priority: 2, name: 'Tax return')
while (!empty) { println remove() }
}

View file

@ -0,0 +1,3 @@
import Data.PQueue.Prio.Min
main = print (toList (fromList [(3, "Clear drains"),(4, "Feed cat"),(5, "Make tea"),(1, "Solve RC tasks"), (2, "Tax return")]))

View file

@ -0,0 +1,3 @@
import qualified Data.Set as S
main = print (S.toList (S.fromList [(3, "Clear drains"),(4, "Feed cat"),(5, "Make tea"),(1, "Solve RC tasks"), (2, "Tax return")]))

View file

@ -0,0 +1,43 @@
data MinHeap a = Nil | MinHeap { v::a, cnt::Int, l::MinHeap a, r::MinHeap a }
deriving (Show, Eq)
hPush :: (Ord a) => a -> MinHeap a -> MinHeap a
hPush x Nil = MinHeap {v = x, cnt = 1, l = Nil, r = Nil}
hPush x h = if x < vv -- insert element, try to keep the tree balanced
then if hLength (l h) <= hLength (r h)
then MinHeap { v=x, cnt=cc, l=hPush vv ll, r=rr }
else MinHeap { v=x, cnt=cc, l=ll, r=hPush vv rr }
else if hLength (l h) <= hLength (r h)
then MinHeap { v=vv, cnt=cc, l=hPush x ll, r=rr }
else MinHeap { v=vv, cnt=cc, l=ll, r=hPush x rr }
where (vv, cc, ll, rr) = (v h, 1 + cnt h, l h, r h)
hPop :: (Ord a) => MinHeap a -> (a, MinHeap a)
hPop h = (v h, pq) where -- just pop, heed not the tree balance
pq | l h == Nil = r h
| r h == Nil = l h
| v (l h) <= v (r h) = let (vv,hh) = hPop (l h) in
MinHeap {v = vv, cnt = hLength hh + hLength (r h),
l = hh, r = r h}
| otherwise = let (vv,hh) = hPop (r h) in
MinHeap {v = vv, cnt = hLength hh + hLength (l h),
l = l h, r = hh}
hLength :: (Ord a) => MinHeap a -> Int
hLength Nil = 0
hLength h = cnt h
hFromList :: (Ord a) => [a] -> MinHeap a
hFromList = foldl (flip hPush) Nil
hToList :: (Ord a) => MinHeap a -> [a]
hToList = unfoldr f where
f Nil = Nothing
f h = Just $ hPop h
main = mapM_ print $ hToList $ hFromList [
(3, "Clear drains"),
(4, "Feed cat"),
(5, "Make tea"),
(1, "Solve RC tasks"),
(2, "Tax return")]

View file

@ -0,0 +1,124 @@
data MinHeap kv = MinHeapEmpty
| MinHeapLeaf !kv
| MinHeapNode !kv {-# UNPACK #-} !Int !(MinHeap a) !(MinHeap a)
deriving (Show, Eq)
emptyPQ :: MinHeap kv
emptyPQ = MinHeapEmpty
isEmptyPQ :: PriorityQ kv -> Bool
isEmptyPQ Mt = True
isEmptyPQ _ = False
sizePQ :: (Ord kv) => MinHeap kv -> Int
sizePQ MinHeapEmpty = 0
sizePQ (MinHeapLeaf _) = 1
sizePQ (MinHeapNode _ cnt _ _) = cnt
peekMinPQ :: MinHeap kv -> Maybe kv
peekMinPQ MinHeapEmpty = Nothing
peekMinPQ (MinHeapLeaf v) = Just v
peekMinPQ (MinHeapNode v _ _ _) = Just v
pushPQ :: (Ord kv) => kv -> MinHeap kv -> MinHeap kv
pushPQ kv pq = insert kv 0 pq where -- insert element, keeping the tree balanced
insert kv _ MinHeapEmpty = MinHeapLeaf kv
insert kv _ (MinHeapLeaf vv) = if kv <= vv
then MinHeapNode kv 2 (MinHeapLeaf vv) MinHeapEmpty
else MinHeapNode vv 2 (MinHeapLeaf kv) MinHeapEmpty
insert kv msk (MinHeapNode vv cc ll rr) = if kv <= vv
then if nmsk >= 0
then MinHeapNode kv nc (insert vv nmsk ll) rr
else MinHeapNode kv nc ll (insert vv nmsk rr)
else if nmsk >= 0
then MinHeapNode vv nc (insert kv nmsk ll) rr
else MinHeapNode vv nc ll (insert kv nmsk rr)
where nc = cc + 1
nmsk = if msk /= 0 then msk `shiftL` 1 -- walk path to next
else let s = floor $ (log $ fromIntegral nc) / log 2 in
(nc `shiftL` ((finiteBitSize cc) - s)) .|. 1 --never 0 again
siftdown :: (Ord kv) => kv -> Int -> MinHeap kv -> MinHeap kv -> MinHeap kv
siftdown kv cnt lft rght = replace cnt lft rght where
replace cc ll rr = case rr of -- adj to put kv in current left/right
MinHeapEmpty -> -- means left is a MinHeapLeaf
case ll of { (MinHeapLeaf vl) ->
if kv <= vl
then MinHeapNode kv 2 ll MinHeapEmpty
else MinHeapNode vl 2 (MinHeapLeaf kv) MinHeapEmpty }
MinHeapLeaf vr ->
case ll of
MinHeapLeaf vl -> if vl <= vr
then if kv <= vl then MinHeapNode kv cc ll rr
else MinHeapNode vl cc (MinHeapLeaf kv) rr
else if kv <= vr then MinHeapNode kv cc ll rr
else MinHeapNode vr cc ll (MinHeapLeaf kv)
MinHeapNode vl ccl lll rrl -> if vl <= vr
then if kv <= vl then MinHeapNode kv cc ll rr
else MinHeapNode vl cc (replace ccl lll rrl) rr
else if kv <= vr then MinHeapNode kv cc ll rr
else MinHeapNode vr cc ll (MinHeapLeaf kv)
MinHeapNode vr ccr llr rrr -> case ll of
(MinHeapNode vl ccl lll rrl) -> -- right is node, so is left
if vl <= vr then
if kv <= vl then MinHeapNode kv cc ll rr
else MinHeapNode vl cc (replace ccl lll rrl) rr
else if kv <= vr then MinHeapNode kv cc ll rr
else MinHeapNode vr cc ll (replace ccr llr rrr)
replaceMinPQ :: (Ord kv) => a -> MinHeap kv -> MinHeap kv
replaceMinPQ _ MinHeapEmpty = MinHeapEmpty
replaceMinPQ kv (MinHeapLeaf _) = MinHeapLeaf kv
replaceMinPQ kv (MinHeapNode _ cc ll rr) = siftdown kv cc ll rr where
deleteMinPQ :: (Ord kv) => MinHeap kv -> MinHeap kv
deleteMinPQ MinHeapEmpty = MinHeapEmpty -- remove min keeping tree balanced
deleteMinPQ pq = let (dkv, npq) = delete 0 pq in
replaceMinPQ dkv npq where
delete _ (MinHeapLeaf vv) = (vv, MinHeapEmpty)
delete msk (MinHeapNode vv cc ll rr) =
if rr == MinHeapEmpty -- means left is MinHeapLeaf
then case ll of (MinHeapLeaf vl) -> (vl, MinHeapLeaf vv)
else if nmsk >= 0 -- means only deal with left
then let (dv, npq) = delete nmsk ll in
(dv, MinHeapNode vv (cc - 1) npq rr)
else let (dv, npq) = delete nmsk rr in
(dv, MinHeapNode vv (cc - 1) ll npq)
where nmsk = if msk /= 0 then msk `shiftL` 1 -- walk path to last
else let s = floor $ (log $ fromIntegral cc) / log 2 in
(cc `shiftL` ((finiteBitSize cc) - s)) .|. 1 --never 0 again
adjustPQ :: (Ord kv) => (kv -> kv) -> MinHeap kv -> MinHeap kv
adjustPQ f pq = adjust pq where -- applies function to every element and reheapifies
adjust MinHeapEmpty = MinHeapEmpty
adjust (MinHeapLeaf v) = MinHeapLeaf (f v)
adjust (MinHeapNode vv cc ll rr) = siftdown (f vv) cc (adjust ll) (adjust rr)
fromListPQ :: (Ord kv) => [kv] -> MinHeap kv
-- fromListPQ = foldl (flip pushPQ) MinHeapEmpty -- O(n log n) time; slow
fromListPQ [] = MinHeapEmpty -- O(n) time using "adjust id" which is O(n)
fromListPQ xs = let (_, pq) = build 1 xs in pq where
sz = length xs
szd2 = sz `div` 2
build _ [] = ([], MinHeapEmpty)
build lvl (x:xs') = if lvl > szd2 then (xs', MinHeapLeaf x)
else let nlvl = lvl + lvl in
let (xrl, pql) = build nlvl xs' in
let (xrr, pqr) = if nlvl >= sz
then (xrl, MinHeapEmpty) -- no right leaf
else build (nlvl + 1) xrl in
let cnt = sizePQ pql + sizePQ pqr + 1 in
(xrr, siftdown x cnt pql pqr)
popMinPQ :: (Ord kv) => MinHeap kv -> Maybe (kv, MinHeap kv)
popMinPQ pq = case peekMinPQ pq of
Nothing -> Nothing
Just v -> Just (v, deleteMinPQ pq)
toListPQ :: (Ord kv) => MinHeap kv -> [kv]
toListPQ = unfoldr f where
f MinHeapEmpty = Nothing
f pq = popMinPQ pq
sortPQ :: (Ord kv) => [kv] -> [kv]
sortPQ ls = toListPQ $ fromListPQ ls

View file

@ -0,0 +1,104 @@
data PriorityQ k v = Mt
| Br !k v !(PriorityQ k v) !(PriorityQ k v)
deriving (Eq, Ord, Read, Show)
emptyPQ :: PriorityQ k v
emptyPQ = Mt
isEmptyPQ :: PriorityQ k v -> Bool
isEmptyPQ Mt = True
isEmptyPQ _ = False
-- The size function isn't from the ML code, but an implementation was
-- suggested by Bertram Felgenhauer on Haskell Cafe, so it is included.
-- Return number of elements in the priority queue.
-- /O(log(n)^2)/
sizePQ :: PriorityQ k v -> Int
sizePQ Mt = 0
sizePQ (Br _ _ pl pr) = 2 * n + rest n pl pr where
n = sizePQ pr
-- rest n p q, where n = sizePQ q, and sizePQ p - sizePQ q = 0 or 1
-- returns 1 + sizePQ p - sizePQ q.
rest :: Int -> PriorityQ k v -> PriorityQ k v -> Int
rest 0 Mt _ = 1
rest 0 _ _ = 2
rest n (Br _ _ ll lr) (Br _ _ rl rr) = case r of
0 -> rest d ll rl -- subtree sizes: (d or d+1), d; d, d
1 -> rest d lr rr -- subtree sizes: d+1, (d or d+1); d+1, d
where m1 = n - 1
d = m1 `shiftR` 1
r = m1 .&. 1
peekMinPQ :: PriorityQ k v -> Maybe (k, v)
peekMinPQ Mt = Nothing
peekMinPQ (Br k v _ _) = Just (k, v)
pushPQ :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
pushPQ wk wv Mt = Br wk wv Mt Mt
pushPQ wk wv (Br vk vv pl pr)
| wk <= vk = Br wk wv (pushPQ vk vv pr) pl
| otherwise = Br vk vv (pushPQ wk wv pr) pl
siftdown :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v -> PriorityQ k v
siftdown wk wv Mt _ = Br wk wv Mt Mt
siftdown wk wv (pl @ (Br vk vv _ _)) Mt
| wk <= vk = Br wk wv pl Mt
| otherwise = Br vk vv (Br wk wv Mt Mt) Mt
siftdown wk wv (pl @ (Br vkl vvl pll plr)) (pr @ (Br vkr vvr prl prr))
| wk <= vkl && wk <= vkr = Br wk wv pl pr
| vkl <= vkr = Br vkl vvl (siftdown wk wv pll plr) pr
| otherwise = Br vkr vvr pl (siftdown wk wv prl prr)
replaceMinPQ :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
replaceMinPQ wk wv Mt = Mt
replaceMinPQ wk wv (Br _ _ pl pr) = siftdown wk wv pl pr
deleteMinPQ :: (Ord k) => PriorityQ k v -> PriorityQ k v
deleteMinPQ Mt = Mt
deleteMinPQ (Br _ _ pr Mt) = pr
deleteMinPQ (Br _ _ pl pr) = let (k, v, npl) = leftrem pl in
siftdown k v pr npl where
leftrem (Br k v Mt Mt) = (k, v, Mt)
leftrem (Br vk vv (Br k v _ _) Mt) = (k, v, Br vk vv Mt Mt)
leftrem (Br vk vv pl pr) = let (k, v, npl) = leftrem pl in
(k, v, Br vk vv pr npl)
-- the following function has been added to the ML code to apply a function
-- to all the entries in the queue and reheapify in O(n) time
adjustPQ :: (Ord k) => (k -> v -> (k, v)) -> PriorityQ k v -> PriorityQ k v
adjustPQ f pq = adjust pq where -- applies function to every element and reheapifies
adjust Mt = Mt
adjust (Br vk vv pl pr) = let (k, v) = f vk vv in
siftdown k v (adjust pl) (adjust pr)
fromListPQ :: (Ord k) => [(k, v)] -> PriorityQ k v
-- fromListPQ = foldl (flip pushPQ) Mt -- O(n log n) time; slow
fromListPQ [] = Mt -- O(n) time using adjust-from-bottom which is O(n)
fromListPQ xs = let (pq, _) = build (length xs) xs in pq where
build 0 xs = (Mt, xs)
build lvl ((k, v):xs') = let (pl, xrl) = build (lvl `shiftR` 1) xs'
(pr, xrr) = build ((lvl - 1) `shiftR` 1) xrl in
(siftdown k v pl pr, xrr)
-- the following function has been added to merge two queues in O(m + n) time
-- where m and n are the sizes of the two queues
mergePQ :: (Ord k) => PriorityQ k v -> PriorityQ k v -> PriorityQ k v
mergePQ pq1 Mt = pq1 -- from concatenated "dumb" list
mergePQ Mt pq2 = pq2 -- in O(m + n) time where m,n are sizes pq1,pq2
mergePQ pq1 pq2 = fromListPQ (zipper pq1 $ zipper pq2 []) where
zipper (Br wk wv Mt _) appndlst = (wk, wv) : appndlst
zipper (Br wk wv pl Mt) appndlst = (wk, wv) : zipper pl appndlst
zipper (Br wk wv pl pr) appndlst = (wk, wv) : zipper pl (zipper pr appndlst)
popMinPQ :: (Ord k) => PriorityQ k v -> Maybe ((k, v), PriorityQ k v)
popMinPQ pq = case peekMinPQ pq of
Nothing -> Nothing
Just kv -> Just (kv, deleteMinPQ pq)
toListPQ :: (Ord k) => PriorityQ k v -> [(k, v)]
toListPQ Mt = [] -- unfoldr popMinPQ
toListPQ pq @ (Br vk vv _ _) = (vk, vv) : (toListPQ $ deleteMinPQ pq)
sortPQ :: (Ord k) => [(k, v)] -> [(k, v)]
sortPQ ls = toListPQ $ fromListPQ ls

View file

@ -0,0 +1,18 @@
testList = [ (3, "Clear drains"),
(4, "Feed cat"),
(5, "Make tea"),
(1, "Solve RC tasks"),
(2, "Tax return") ]
testPQ = fromListPQ testList
main = do -- slow build
mapM_ print $ toListPQ $ foldl (\pq (k, v) -> pushPQ k v pq) emptyPQ testList
putStrLn "" -- fast build
mapM_ print $ toListPQ $ fromListPQ testList
putStrLn "" -- combined fast sort
mapM_ print $ sortPQ testList
putStrLn "" -- test merge
mapM_ print $ toListPQ $ mergePQ testPQ testPQ
putStrLn "" -- test adjust
mapM_ print $ toListPQ $ adjustPQ (\x y -> (x * (-1), y)) testPQ

View file

@ -0,0 +1,13 @@
import Utils # For Closure class
import Collections # For Heap (dense priority queue) class
procedure main()
pq := Heap(, Closure("[]",Arg,1) )
pq.add([3, "Clear drains"])
pq.add([4, "Feed cat"])
pq.add([5, "Make tea"])
pq.add([1, "Solve RC tasks"])
pq.add([2, "Tax return"])
while task := pq.get() do write(task[1]," -> ",task[2])
end

View file

@ -0,0 +1,23 @@
coclass 'priorityQueue'
PRI=: ''
QUE=: ''
insert=:4 :0
p=. PRI,x
q=. QUE,y
assert. p -:&$ q
assert. 1 = #$q
ord=: \: p
QUE=: ord { q
PRI=: ord { p
i.0 0
)
topN=:3 :0
assert y<:#PRI
r=. y{.QUE
PRI=: y}.PRI
QUE=: y}.QUE
r
)

View file

@ -0,0 +1,9 @@
Q=: conew'priorityQueue'
3 4 5 1 2 insert__Q 'clear drains';'feed cat';'make tea';'solve rc task';'tax return'
>topN__Q 1
make tea
>topN__Q 4
feed cat
clear drains
tax return
solve rc task

View file

@ -0,0 +1,31 @@
import java.util.PriorityQueue;
class Task implements Comparable<Task> {
final int priority;
final String name;
public Task(int p, String n) {
priority = p;
name = n;
}
public String toString() {
return priority + ", " + name;
}
public int compareTo(Task other) {
return priority < other.priority ? -1 : priority > other.priority ? 1 : 0;
}
public static void main(String[] args) {
PriorityQueue<Task> pq = new PriorityQueue<Task>();
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())
System.out.println(pq.remove());
}
}

View file

@ -0,0 +1,49 @@
# In the following, pq stands for "priority queue".
# Add an item with the given priority (an integer,
# or a string representing an integer)
# Input: a pq
def pq_add(priority; item):
(priority|tostring) as $p
| if .priorities|index($p) then
if (.[$p] | index(item)) then . else .[$p] += [item] end
else .[$p] = [item] | .priorities = (.priorities + [$p] | sort)
end ;
# emit [ item, pq ]
# Input: a pq
def pq_pop:
.priorities as $keys
| if ($keys|length) == 0 then [ null, . ]
else
if (.[$keys[0]] | length) == 1
then .priorities = .priorities[1:]
else .
end
| [ (.[$keys[0]])[0], (.[$keys[0]] = .[$keys[0]][1:]) ]
end ;
# Emit the item that would be popped, or null if there is none
# Input: a pq
def pq_peep:
.priorities as $keys
| if ($keys|length) == 0 then null
else (.[$keys[0]])[0]
end ;
# Add a bunch of tasks, presented as an array of arrays
# Input: a pq
def pq_add_tasks(list):
reduce list[] as $pair (.; . + pq_add( $pair[0]; $pair[1]) ) ;
# Pop all the tasks, producing a stream
# Input: a pq
def pq_pop_tasks:
pq_pop as $pair
| if $pair[0] == null then empty
else $pair[0], ( $pair[1] | pq_pop_tasks )
end ;
# Input: a bunch of tasks, presented as an array of arrays
def prioritize:
. as $list | {} | pq_add_tasks($list) | pq_pop_tasks ;

View file

@ -0,0 +1,6 @@
[ [3, "Clear drains"],
[4, "Feed cat"],
[5, "Make tea"],
[1, "Solve RC tasks"],
[2, "Tax return"]
] | prioritize

View file

@ -0,0 +1,19 @@
using Base.Collections
test = ["Clear drains" 3;
"Feed cat" 4;
"Make tea" 5;
"Solve RC tasks" 1;
"Tax return" 2]
task = PriorityQueue(Base.Order.Reverse)
for i in 1:size(test)[1]
enqueue!(task, test[i,1], test[i,2])
end
println("Tasks, completed according to priority:")
while !isempty(task)
(t, p) = peek(task)
dequeue!(task)
println(" \"", t, "\" has priority ", p)
end

View file

@ -0,0 +1,20 @@
import java.util.PriorityQueue
internal data class Task(val priority: Int, val name: String) : Comparable<Task> {
override fun compareTo(other: Task) = when {
priority < other.priority -> -1
priority > other.priority -> 1
else -> 0
}
}
private infix fun String.priority(priority: Int) = Task(priority, this)
fun main(args: Array<String>) {
val q = PriorityQueue(listOf("Clear drains" priority 3,
"Feed cat" priority 4,
"Make tea" priority 5,
"Solve RC tasks" priority 1,
"Tax return" priority 2))
while (q.any()) println(q.remove())
}

View file

@ -0,0 +1,59 @@
define priorityQueue => type {
data
store = map,
cur_priority = void
public push(priority::integer, value) => {
local(store) = .`store`->find(#priority)
if(#store->isA(::array)) => {
#store->insert(#value)
return
}
.`store`->insert(#priority=array(#value))
.`cur_priority`->isA(::void) or #priority < .`cur_priority`
? .`cur_priority` = #priority
}
public pop => {
.`cur_priority` == void
? return void
local(store) = .`store`->find(.`cur_priority`)
local(retVal) = #store->first
#store->removeFirst&size > 0
? return #retVal
// Need to find next priority
.`store`->remove(.`cur_priority`)
if(.`store`->size == 0) => {
.`cur_priority` = void
else
// There are better / faster ways to do this
// The keys are actually already sorted, but the order of
// storage in a map is not actually defined, can't rely on it
.`cur_priority` = .`store`->keys->asArray->sort&first
}
return #retVal
}
public isEmpty => (.`store`->size == 0)
}
local(test) = priorityQueue
#test->push(2,`e`)
#test->push(1,`H`)
#test->push(5,`o`)
#test->push(2,`l`)
#test->push(5,`!`)
#test->push(4,`l`)
while(not #test->isEmpty) => {
stdout(#test->pop)
}

View file

@ -0,0 +1,22 @@
?- 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'

View file

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

View file

@ -0,0 +1,50 @@
PriorityQueue = {
__index = {
put = function(self, p, v)
local q = self[p]
if not q then
q = {first = 1, last = 0}
self[p] = q
end
q.last = q.last + 1
q[q.last] = v
end,
pop = function(self)
for p, q in pairs(self) do
if q.first <= q.last then
local v = q[q.first]
q[q.first] = nil
q.first = q.first + 1
return p, v
else
self[p] = nil
end
end
end
},
__call = function(cls)
return setmetatable({}, cls)
end
}
setmetatable(PriorityQueue, PriorityQueue)
-- Usage:
pq = PriorityQueue()
tasks = {
{3, 'Clear drains'},
{4, 'Feed cat'},
{5, 'Make tea'},
{1, 'Solve RC tasks'},
{2, 'Tax return'}
}
for _, task in ipairs(tasks) do
print(string.format("Putting: %d - %s", unpack(task)))
pq:put(unpack(task))
end
for prio, task in pq.pop, pq do
print(string.format("Popped: %d - %s", prio, task))
end

View file

@ -0,0 +1,40 @@
-- Use socket.gettime() for benchmark measurements
-- since it has millisecond precision on most systems
local socket = require("socket")
n = 10000000 -- number of tasks added (10^7)
m = 1000 -- number different priorities
local pq = PriorityQueue()
print(string.format("Adding %d tasks with random priority 1-%d ...", n, m))
start = socket.gettime()
for i = 1, n do
pq:put(math.random(m), i)
end
print(string.format("Elapsed: %.3f ms.", (socket.gettime() - start) * 1000))
print("Retrieving all tasks in order...")
start = socket.gettime()
local pp = 0
local pv = 0
for i = 1, n do
local p, task = pq:pop()
-- check that tasks are popped in ascending priority
assert(p >= pp)
if pp == p then
-- check that tasks within one priority maintain the insertion order
assert(task > pt)
end
pp = p
pt = task
end
print(string.format("Elapsed: %.3f ms.", (socket.gettime() - start) * 1000))

View file

@ -0,0 +1,115 @@
Module UnOrderedArray {
Class PriorityQueue {
Private:
Dim Item()
many=0, level=0, first
cmp = lambda->0
Module Reduce {
if .many<.first*2 then exit
if .level<.many/2 then .many/=2 : Dim .Item(.many)
}
Public:
Module Clear {
Dim .Item() \\ erase all
.many<=0 \\ default
.Level<=0
}
Module Add {
if .level=.many then
if .many=0 then Error "Define Size First"
Dim .Item(.many*2)
.many*=2
end if
Read Item
if .level=0 then
.Item(0)=Item
else.If .cmp(.Item(0), Item)=-1 then \\ Item is max
.Item(.level)=Item
swap .Item(0), .Item(.level)
else
.Item(.level)=Item
end if
.level++
}
Function Peek {
if .level=0 then error "empty"
=.Item(0)
}
Function Poll {
if .level=0 then error "empty"
=.Item(0)
if .level=2 then
swap .Item(0), .Item(1)
.Item(1)=0
.Level<=1
else.If .level>2 then
.Level--
Swap .Item(.level), .Item(0)
.Item(.level)=0
for I=.level-1 to 1
if .cmp(.Item(I), .Item(I-1))=1 then Swap .Item(I), .Item(I-1)
next
else
.level<=0 : .Item(0)=0
end if
.Reduce
}
Module Remove {
if .level=0 then error "empty"
Read Item
k=true
if .cmp(.Item(0), Item)=0 then
Item=.Poll()
K~ \\ k=false
else.If .Level>1 then
I2=.Level-1
for I=1 to I2
if k then
if .cmp(.Item(I), Item)=0 then
if I<I2 then Swap .Item(I), .Item(I2)
.Item(I2)=0
k=false
end if
else
exit
end if
next
.Level--
end if
if k then Error "Not Found"
.Reduce
}
Function Size {
if .many=0 then Error "Define Size First"
=.Level
}
Class:
Module PriorityQueue {
if .many>0 then Error "Clear List First"
Read .many, .cmp
.first<=.many
Dim .Item(.many)
}
}
Class Item { X, S$
Class: // constructor as temporary definition
Module Item {Read .X, .S$}
}
Queue=PriorityQueue(100, Lambda -> {Read A,B : =Compare(A.X,B.X)})
Queue.Add Item(3, "Clear drains") : Gosub PrintTop()
Queue.Add Item(4 ,"Feed cat") : PrintTop()
Queue.Add Item(5 ,"Make tea") : PrintTop()
Queue.Add Item(1 ,"Solve RC tasks") : PrintTop()
Queue.Add Item(2 ,"Tax return") : PrintTop()
Print "remove items"
While true
MM=Queue.Poll() :Print MM.X, MM.S$,,"Size="; Queue.Size()
if Queue.Size()=0 then exit
PrintTop()
End While
Sub PrintTop()
M=Queue.Peek() : Print "Item ";M.X, M.S$
End Sub
}
UnOrderedArray

View file

@ -0,0 +1,57 @@
Module PriorityQueue {
a= ((3, "Clear drains"), (4 ,"Feed cat"), ( 5 , "Make tea"))
a=cons(a, ((1 ,"Solve RC tasks"), ( 2 , "Tax return")))
b=stack
comp=lambda (a, b) -> array(a, 0)<array(b, 0)
module InsertPQ (a, n, &comp) {
if len(a)=0 then stack a {data n} : exit
if comp(n, stackitem(a)) then stack a {push n} : exit
stack a {
push n
t=2: b=len(a)
m=b
while t<=b
t1=m
m=(b+t) div 2
if m=0 then m=t1 : exit
If comp(stackitem(m),n) then t=m+1: continue
b=m-1
m=b
end while
if m>1 then shiftback m
}
}
n=each(a)
while n
InsertPq b, array(n), &comp
end while
n1=each(b)
while n1
m=stackitem(n1)
print array(m, 0), array$(m, 1)
end while
\\ Peek topitem (without popping)
print Array$(stackitem(b), 1)
\\ Pop item
Stack b {
Read old
}
print Array$(old, 1)
def Peek$(a)=Array$(stackitem(a), 1)
Function Pop$(a) {
stack a {
=Array$(stackitem(), 1)
drop
}
}
print Peek$(b)
print Pop$(b)
def IsEmpty(a)=len(a)=0
while not IsEmpty(b)
print pop$(b)
end while
}
PriorityQueue

View file

@ -0,0 +1,83 @@
// class definitions are global
// if there aren't defintions in a class
global countmany=0&
class obj {
x, s$
property toString$ {
value (sp=8) {
link parent x, s$ to x, s$
value$=format$("{0::-5}"+string$(" ", sp)+"{1:20}", x, s$)
}
}
remove {
countmany--
}
class:
module obj (.x, .s$) {countmany++}
}
Module PriorityQueueForGroups {
Flush ' empty current stack
Data obj(3, "Clear drains"), obj(4 ,"Feed cat"), obj( 5 , "Make tea")
Data obj( 1 ,"Solve RC tasks"), obj( 2 , "Tax return")
ObjectCount()
b=stack
while not empty
InsertPQ(b) // top of stack is b then objects follow
end while
ObjectCount()
Print "Using Peek to Examine Priority Queue"
n1=each(b)
Header()
while n1
Print @Peek$(n1)
end while
ObjectCount()
Header()
while not @isEmpty(b)
Print @Pop(b)=>tostring$
end while
ObjectCount()
// here are the subs/simple functions
// these are static parts of module
sub Header()
Print " Priority Task"
Print "========== ================"
end sub
sub ObjectCount()
Print "There are ";countmany;" objects of type obj"
end sub
sub InsertPQ(a, n)
Print "Insert:";n.tostring$(1)
if len(a)=0 then stack a {data n} : exit sub
if @comp(n, stackitem(a)) then stack a {push n} : exit sub
stack a {
push n
local t=2, b=len(a)
local m=b
while t<=b
t1=m
m=(b+t) div 2
if m=0 then m=t1 : exit
If @comp(stackitem(m),n) then t=m+1: continue
b=m-1
m=b
end while
if m>1 then shiftback m
}
end sub
function comp(a, b)
=a.x<b.x
end function
function Peek$(a as stack)
=stackitem(a)=>toString$
countmany++
end function
function IsEmpty(a)
=len(a)=0
end function
Function Pop(a)
// Group make a copy
stack a {=Group:countmany++}
end function
}
PriorityQueueForGroups

View file

@ -0,0 +1,123 @@
global countmany=0&
class obj {
x, s$
property toString$ {
value (sp=8) {
link parent x, s$ to x, s$
value$=format$("{0::-5}"+string$(" ", sp)+"{1:20}", x, s$)
}
}
function Copy {
countmany++
z=this
=pointer((z))
}
remove {
countmany--
}
class:
module obj (.x, .s$) {countmany++}
}
// obj() return object as value (using a special pointer)
function global g(priority, task$) {
// here we return an object using nonrmal pointer
// try to change -> to = to see the error
->obj(priority, task$)
}
Module PriorityQueueForGroups {
Flush ' empty current stack
Data g(3, "Clear drains"),g(4 ,"Feed cat"), g( 5 , "Make tea")
Data g( 1 ,"Solve RC tasks")
ObjectCount()
pq=stack
zz=stack
while not empty
InsertPQ(pq) // top of stack is pq then objects follow
end while
Pen 15 {
data g(2 , "Tax return"), g(1 ,"Solve RC tasks#2")
while not empty: InsertPq(zz): End While
n1=each(zz,-1,1)
Header()
while n1
Print @Peek$(stackitem(n1))
end while
}
MergePq(pq, zz, false)
InsertPq(pq, g(1 ,"Solve RC tasks#3"))
ObjectCount()
Print "Using Peek to Examine Priority Queue"
n1=each(pq,-1, 1)
Header()
while n1
Print @Peek$(stackitem(n1))
end while
ObjectCount()
Header()
while not @isEmpty(pq)
Print @Pop(pq)=>tostring$
end while
ObjectCount()
Header()
while not @isEmpty(zz)
Print @Pop(zz)=>tostring$
end while
ObjectCount()
// here are the subs/simple functions
// these are static parts of module
sub Header()
Print " Priority Task"
Print "========== ================"
end sub
sub ObjectCount()
Print "There are ";countmany;" objects of type obj"
end sub
sub MergePq(a, pq, emptyqueue)
local n1=each(pq, -1, 1), z=pointer()
while n1
if emptyqueue then
stack pq {
shiftback len(pq)
InsertPQ(a, Group)
}
else
z=stackitem(n1)
InsertPQ(a, z=>copy())
end if
end while
end sub
sub InsertPQ(a, n as *obj)
Print "Insert:";n=>tostring$(1)
if len(a)=0 then stack a {data n} : exit sub
if @comp(n, stackitem(a)) then stack a {push n} : exit sub
stack a {
push n
local t=2, pq=len(a), t1=0
local m=pq
while t<=pq
t1=m
m=(pq+t) div 2
if m=0 then m=t1 : exit
If @comp(stackitem(m),n) then t=m+1: continue
pq=m-1
m=pq
end while
if m>1 then shiftback m
}
end sub
function comp(a as *obj, pq as *obj)
=a=>x>pq=>x
end function
function Peek$(a as *obj)
=a=>toString$
end function
function IsEmpty(a)
=len(a)=0
end function
function Pop(a)
// Group make a copy (but here is a pointer of group)
stack a {shift stack.size
=Group}
end function
}
PriorityQueueForGroups

View file

@ -0,0 +1,100 @@
form 80, 42
Module OrdrerQueue (filename$) {
// f=-2 or use empty filename for screen
open filename$ for output as #f
zz=list
pq=List
flush
// subs can read from module's stack
println("Add items to pq queue")
Data 4 ,"Feed cat",5 , "Make tea", 3, "Clear drains",1 , "Solve RC tasks"
AddItems(pq)
println("Add items to zz queue")
AddItems(zz, 2 , "Tax return", 1 ,"Solve RC tasks#2")
println("Peek top from zz queue")
PeekTop(zz) // Solve RC tasks#2
println("Merge two priority lists")
merge(pq, zz, false)
println("Peek top from pq queue")
PeekTop(pq) // Solve RC tasks
println("Add items to pq queue")
AddItems(pq, 1 ,"Solve RC tasks#3")
println("Peek top from pq queue")
PeekTop(pq) // Solve RC tasks
println("Pop one from pq until empty queue")
while len(pq)>0
PopOne(pq)
end while
println("Pop one from zz until empty queue")
while len(zz)>0
PopOne(zz)
end while
close #f
sub AddItems(pq)
local s, z
while not empty
read z
if not exist(pq, z) then s=stack:append pq, z:=s else s=eval(pq)
read what$: stack s {data what$}
stack new {println( "add item",z,what$)}
end while
sort descending pq as number
Println()
end sub
sub merge(pq, qp, emptyqueue)
local needsort=false
local kqp=each(qp, -1, 1), k$, t, p
while kqp
t=eval(kqp)
k$= eval$(kqp!)
if not exist(pq, eval$(kqp!)) then
p=stack
append pq, val(eval$(kqp!)):=p
needsort=true
else
p=eval(pq)
end if
stack p {
if emptyqueue then
data !t
delete qp,eval$(kqp!)
else
data !stack(t)
end if
}
end while
if needsort then sort descending pq as number
end sub
sub PeekTop(pq)
Local k=len(pq)
if k=0 then exit sub
k=val(eval$(pq, k-1))
if exist(pq, k) then local s=eval(pq): println( k,stackitem$(s, 1))
End sub
Sub PopOne(pq)
Local k=len(pq)
if k<0 then exit sub
k=val(eval$(pq, k-1))
if exist(pq, k) then
local s=eval(pq)
println( k,stackitem$(s, 1))
if len(s)=1 then
delete pq, k
else
stack s {drop}
end if
end if
end sub
Sub println()
if empty then print #f, "": exit sub
while not empty
if islet then print #f, letter$;
if empty else print #f, " ";
if isnum then print #f, number;
if empty else print #f, " ";
end while
if f=-2 and pos=0 then exit sub
print #f, ""
end sub
}
OrdrerQueue ""

View file

@ -0,0 +1,10 @@
push = Function[{queue, priority, item},
queue = SortBy[Append[queue, {priority, item}], First], HoldFirst];
pop = Function[queue,
If[Length@queue == 0, Null,
With[{item = queue[[-1, 2]]}, queue = Most@queue; item]],
HoldFirst];
peek = Function[queue,
If[Length@queue == 0, Null, Max[queue[[All, 1]]]], HoldFirst];
merge = Function[{queue1, queue2},
SortBy[Join[queue1, queue2], First], HoldAll];

View file

@ -0,0 +1,11 @@
queue = {};
push[queue, 3, "Clear drains"];
push[queue, 4, "Feed cat"];
push[queue, 5, "Make tea"];
push[queue, 1, "Solve RC tasks"];
push[queue, 2, "Tax return"];
Print[peek[queue]];
Print[pop[queue]];
queue1 = {};
push[queue1, 6, "Drink tea"];
Print[merge[queue, queue1]];

View file

@ -0,0 +1,82 @@
/* Naive implementation using a sorted list of pairs [key, [item[1], ..., item[n]]].
The key may be any number (integer or not). Items are extracted in FIFO order. */
defstruct(pqueue(q = []))$
/* Binary search */
find_key(q, p) := block(
[i: 1, j: length(q), k, c],
if j = 0 then false
elseif (c: q[i][1]) >= p then
(if c = p then i else false)
elseif (c: q[j][1]) <= p then
(if c = p then j else false)
else catch(
while j >= i do (
k: quotient(i + j, 2),
if (c: q[k][1]) = p then throw(k)
elseif c < p then i: k + 1 else j: k - 1
),
false
)
)$
pqueue_push(pq, x, p) := block(
[q: pq@q, k],
k: find_key(q, p),
if integerp(k) then q[k][2]: endcons(x, q[k][2])
else pq@q: sort(cons([p, [x]], q)),
'done
)$
pqueue_pop(pq) := block(
[q: pq@q, v, x],
if emptyp(q) then 'fail else (
p: q[1][1],
v: q[1][2],
x: v[1],
if length(v) > 1 then q[1][2]: rest(v) else pq@q: rest(q),
x
)
)$
pqueue_print(pq) := block([t], while (t: pqueue_pop(pq)) # 'fail do disp(t))$
/* An example */
a: new(pqueue)$
pqueue_push(a, "take milk", 4)$
pqueue_push(a, "take eggs", 4)$
pqueue_push(a, "take wheat flour", 4)$
pqueue_push(a, "take salt", 4)$
pqueue_push(a, "take oil", 4)$
pqueue_push(a, "carry out crepe recipe", 5)$
pqueue_push(a, "savour !", 6)$
pqueue_push(a, "add strawberry jam", 5 + 1/2)$
pqueue_push(a, "call friends", 5 + 2/3)$
pqueue_push(a, "go to the supermarket and buy food", 3)$
pqueue_push(a, "take a shower", 2)$
pqueue_push(a, "get dressed", 2)$
pqueue_push(a, "wake up", 1)$
pqueue_push(a, "serve cider", 5 + 3/4)$
pqueue_push(a, "buy also cider", 3)$
pqueue_print(a);
"wake up"
"take a shower"
"get dressed"
"go to the supermarket and buy food"
"buy also cider"
"take milk"
"take butter"
"take flour"
"take salt"
"take oil"
"carry out recipe"
"add strawberry jam"
"call friends"
"serve cider"
"savour !"

View file

@ -0,0 +1,35 @@
:- module test_pqueue.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module int.
:- import_module list.
:- import_module pqueue.
:- import_module string.
:- pred build_pqueue(pqueue(int,string)::in, pqueue(int,string)::out) is det.
build_pqueue(!PQ) :-
pqueue.insert(3, "Clear drains", !PQ),
pqueue.insert(4, "Feed cat", !PQ),
pqueue.insert(5, "Make tea", !PQ),
pqueue.insert(1, "Solve RC tasks", !PQ),
pqueue.insert(2, "Tax return", !PQ).
:- pred display_pqueue(pqueue(int, string)::in, io::di, io::uo) is det.
display_pqueue(PQ, !IO) :-
( pqueue.remove(K, V, PQ, PQO) ->
io.format("Key = %d, Value = %s\n", [i(K), s(V)], !IO),
display_pqueue(PQO, !IO)
;
true
).
main(!IO) :-
build_pqueue(pqueue.init, PQO),
display_pqueue(PQO, !IO).

View file

@ -0,0 +1,60 @@
type
PriElem[T] = tuple
data: T
pri: int
PriQueue[T] = object
buf: seq[PriElem[T]]
count: int
# first element not used to simplify indices
proc initPriQueue[T](initialSize = 4): PriQueue[T] =
result.buf.newSeq(initialSize)
result.buf.setLen(1)
result.count = 0
proc add[T](q: var PriQueue[T], data: T, pri: int) =
var n = q.buf.len
var m = n div 2
q.buf.setLen(n + 1)
# append at end, then up heap
while m > 0 and pri < q.buf[m].pri:
q.buf[n] = q.buf[m]
n = m
m = m div 2
q.buf[n] = (data, pri)
q.count = q.buf.len - 1
proc pop[T](q: var PriQueue[T]): PriElem[T] =
assert q.buf.len > 1
result = q.buf[1]
var qn = q.buf.len - 1
var n = 1
var m = 2
while m < qn:
if m + 1 < qn and q.buf[m].pri > q.buf[m+1].pri:
inc m
if q.buf[qn].pri <= q.buf[m].pri:
break
q.buf[n] = q.buf[m]
n = m
m = m * 2
q.buf[n] = q.buf[qn]
q.buf.setLen(q.buf.len - 1)
q.count = q.buf.len - 1
var p = initPriQueue[string]()
p.add("Clear drains", 3)
p.add("Feed cat", 4)
p.add("Make tea", 5)
p.add("Solve RC tasks", 1)
p.add("Tax return", 2)
while p.count > 0:
echo p.pop()

View file

@ -0,0 +1,12 @@
import HeapQueue
var pq = newHeapQueue[(int, string)]()
pq.push((3, "Clear drains"))
pq.push((4, "Feed cat"))
pq.push((5, "Make tea"))
pq.push((1, "Solve RC tasks"))
pq.push((2, "Tax return"))
while pq.len() > 0:
echo pq.pop()

View file

@ -0,0 +1,18 @@
import tables
var
pq = initTable[int, string]()
proc main() =
pq.add(3, "Clear drains")
pq.add(4, "Feed cat")
pq.add(5, "Make tea")
pq.add(1, "Solve RC tasks")
pq.add(2, "Tax return")
for i in countUp(1,5):
if pq.hasKey(i):
echo i, ": ", pq[i]
pq.del(i)
main()

View file

@ -0,0 +1,17 @@
module PQ = Base.PriorityQueue
let () =
let tasks = [
3, "Clear drains";
4, "Feed cat";
5, "Make tea";
1, "Solve RC tasks";
2, "Tax return";
] in
let pq = PQ.make (fun (prio1, _) (prio2, _) -> prio1 > prio2) in
List.iter (PQ.add pq) tasks;
while not (PQ.is_empty pq) do
let _, task = PQ.first pq in
PQ.remove_first pq;
print_endline task
done

View file

@ -0,0 +1,22 @@
module PQSet = Set.Make
(struct
type t = int * string (* pair of priority and task name *)
let compare = compare
end);;
let () =
let tasks = [
3, "Clear drains";
4, "Feed cat";
5, "Make tea";
1, "Solve RC tasks";
2, "Tax return";
] in
let pq = PQSet.of_list tasks in
let rec aux pq' =
if not (PQSet.is_empty pq') then begin
let prio, name as task = PQSet.min_elt pq' in
Printf.printf "%d, %s\n" prio name;
aux (PQSet.remove task pq')
end
in aux pq

View file

@ -0,0 +1,64 @@
#import <Foundation/Foundation.h>
const void *PQRetain(CFAllocatorRef allocator, const void *ptr) {
return (__bridge_retained const void *)(__bridge id)ptr;
}
void PQRelease(CFAllocatorRef allocator, const void *ptr) {
(void)(__bridge_transfer id)ptr;
}
CFComparisonResult PQCompare(const void *ptr1, const void *ptr2, void *unused) {
return [(__bridge id)ptr1 compare:(__bridge id)ptr2];
}
@interface Task : NSObject {
int priority;
NSString *name;
}
- (instancetype)initWithPriority:(int)p andName:(NSString *)n;
- (NSComparisonResult)compare:(Task *)other;
@end
@implementation Task
- (instancetype)initWithPriority:(int)p andName:(NSString *)n {
if ((self = [super init])) {
priority = p;
name = [n copy];
}
return self;
}
- (NSString *)description {
return [NSString stringWithFormat:@"%d, %@", priority, name];
}
- (NSComparisonResult)compare:(Task *)other {
if (priority == other->priority)
return NSOrderedSame;
else if (priority < other->priority)
return NSOrderedAscending;
else
return NSOrderedDescending;
}
@end
int main (int argc, const char *argv[]) {
@autoreleasepool {
CFBinaryHeapCallBacks callBacks = {0, PQRetain, PQRelease, NULL, PQCompare};
CFBinaryHeapRef pq = CFBinaryHeapCreate(NULL, 0, &callBacks, NULL);
CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:3 andName:@"Clear drains"]);
CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:4 andName:@"Feed cat"]);
CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:5 andName:@"Make tea"]);
CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:1 andName:@"Solve RC tasks"]);
CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:2 andName:@"Tax return"]);
while (CFBinaryHeapGetCount(pq) != 0) {
Task *task = (id)CFBinaryHeapGetMinimum(pq);
NSLog(@"%@", task);
CFBinaryHeapRemoveMinimumValue(pq);
}
CFRelease(pq);
}
return 0;
}

View file

@ -0,0 +1,165 @@
'PRIORITY QUEUE WITH 16 LEVELS
uses console
% pl 16 'priority levels
===================
Class PriorityQueue
===================
indexbase 1
bstring buf[pl] 'buffers to hold priority queues content
int bg[pl] 'buffers base offset
int i[pl] 'indexers
int le[pl] 'length of buffer
method constructor()
====================
int p
for p=1 to pl
buf[p]=""
le[p]=0
bg[p]=0
i=[p]=0
next
end method
method destructor()
===================
int p
for p=1 to pl
del (buf[p])
le[p]=0
bg[p]=0
i=[p]=0
next
end method
method Encodelength(int ls,p)
=============================
int ll at i[p]+strptr(buf[p])
ll=ls
i[p]+=sizeof int
end method
method limit(int*p)
===================
if p>pl
p=pl
endif
if p<1
p=1
endif
end method
method push(string s,int p)
=============================
limit p
int ls
ls=len s
if i[p]+ls+8 > le[p] then
int e=8000+(ls*2) 'extra buffer bytes
buf[p]=buf[p]+nuls e 'extend buf
le[p]=len buf[p]
end if
EncodeLength ls,p 'length of input s
mid buf[p],i[p]+1,s 'patch in s
i[p]+=ls
end method
method popLength(int p) as int
==============================
if bg[p]>=i[p]
return -1 'buffer empty
endif
int ll at (bg[p]+strptr buf[p])
bg[p]+=sizeof int
return ll
end method
method pop(string *s, int *p=1, lpl=0) as int
=============================================
limit p
int ls
do
ls=popLength p
if ls=-1
if not lpl 'lpl: lock priority level
p++ 'try next priority level
if p<=pl
continue do
endif
endif
s=""
return ls 'empty buffers
endif
exit do
loop
s=mid buf[p],bg[p]+1,ls
bg[p]+=ls
'cleanup buffer
if bg[p]>1e6 then
buf[p]=mid buf[p],bg[p]+1 'remove old popped data
le[p]=len buf[p]
i[p]-=bg[p] 'shrink buf
bg[p]=0
end if
end method
method clear()
==============
constructor
end method
end class 'PriorityQueue
'====
'DEMO
'====
new PriorityQueue medo()
string s
def inp
medo.push %2,%1
end def
' Priority Task
' ══════════ ════════════════
inp 3 "Clear drains"
inp 4 "Feed cat"
inp 5 "Make tea"
inp 1 "Solve RC tasks"
inp 2 "Tax return"
inp 4 "Plant beans"
'
int er
int p
print "Priority Task" cr
print "=================" cr
do
er=medo.pop s,p
if er=-1
print "(buffer empty)"
exit do
endif
print p tab s cr
loop
pause
del medo
/*
RESULTS:
Priority Task
=================
1 Solve RC tasks
2 Tax return
3 Clear drains
4 Feed cat
4 Plant beans
5 Make tea
(buffer empty)
*/

View file

@ -0,0 +1,17 @@
<?php
$pq = new SplPriorityQueue;
$pq->insert('Clear drains', 3);
$pq->insert('Feed cat', 4);
$pq->insert('Make tea', 5);
$pq->insert('Solve RC tasks', 1);
$pq->insert('Tax return', 2);
// This line causes extract() to return both the data and priority (in an associative array),
// Otherwise it would just return the data
$pq->setExtractFlags(SplPriorityQueue::EXTR_BOTH);
while (!$pq->isEmpty()) {
print_r($pq->extract());
}
?>

View file

@ -0,0 +1,13 @@
<?php
$pq = new SplMinHeap;
$pq->insert(array(3, 'Clear drains'));
$pq->insert(array(4, 'Feed cat'));
$pq->insert(array(5, 'Make tea'));
$pq->insert(array(1, 'Solve RC tasks'));
$pq->insert(array(2, 'Tax return'));
while (!$pq->isEmpty()) {
print_r($pq->extract());
}
?>

View file

@ -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.

View file

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

View file

@ -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.

View file

@ -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.

View file

@ -0,0 +1,15 @@
use strict;
use warnings;
use feature 'say';
use Heap::Priority;
my $h = Heap::Priority->new;
$h->highest_first(); # higher or lower number is more important
$h->add(@$_) for ["Clear drains", 3],
["Feed cat", 4],
["Make tea", 5],
["Solve RC tasks", 1],
["Tax return", 2];
say while ($_ = $h->pop);

View file

@ -0,0 +1,31 @@
use strict;
use warnings; # in homage to IBM card sorters :)
my $data = <<END;
Priority Task
3 Clear drains
4 Feed cat
5 Make tea
1 Solve RC tasks
2 Tax return
4 Feed dog
END
insert( $1, $2 ) while $data =~ /(\d+)\h+(.*)/g; # insert all data
while( my $item = top_item_removal() ) # get in priority order
{
print "$item\n";
}
######################################################################
my @bins; # priorities limited to small (<1e6 maybe?) non-negative integers
sub insert { push @{ $bins[shift] }, pop } # O(1)
sub top_item_removal # O(1) (sort of, maybe?)
{
delete $bins[-1] while @bins and @{ $bins[-1] // [] } == 0;
shift @{ $bins[-1] // [] };
}

View file

@ -0,0 +1,57 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">tasklist</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">new_dict</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">add_task</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">desc</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">getd_index</span><span style="color: #0000FF;">(</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">putd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">desc</span><span style="color: #0000FF;">},</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">descs</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">getd_by_index</span><span style="color: #0000FF;">(</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">putd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">descs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">desc</span><span style="color: #0000FF;">),</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">list_task_visitor</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">descs</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000080;font-style:italic;">/*user_data*/</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?{</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span><span style="color: #000000;">descs</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span> <span style="color: #000080;font-style:italic;">-- continue</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">list_tasks</span><span style="color: #0000FF;">()</span>
<span style="color: #7060A8;">traverse_dict</span><span style="color: #0000FF;">(</span><span style="color: #000000;">list_task_visitor</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">tasklist</span><span style="color: #0000FF;">,</span> <span style="color: #004600;">true</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">pop_task_visitor</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">descs</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">rid</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">desc</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">descs</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">descs</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">descs</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">descs</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">deld</span><span style="color: #0000FF;">(</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #7060A8;">putd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span><span style="color: #000000;">descs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">rid</span><span style="color: #0000FF;">(</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span><span style="color: #000000;">desc</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">false</span> <span style="color: #000080;font-style:italic;">-- stop</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">pop_task</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">rid</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">dict_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">traverse_dict</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pop_task_visitor</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">rid</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">tasklist</span><span style="color: #0000FF;">,</span> <span style="color: #004600;">true</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">add_task</span><span style="color: #0000FF;">(</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Clear drains"</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">add_task</span><span style="color: #0000FF;">(</span><span style="color: #000000;">4</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Feed cat"</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">add_task</span><span style="color: #0000FF;">(</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Make tea"</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">add_task</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Solve RC tasks"</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">add_task</span><span style="color: #0000FF;">(</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Tax return"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">do_task</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">desc</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?{</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span><span style="color: #000000;">desc</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">list_tasks</span><span style="color: #0000FF;">()</span>
<span style="color: #0000FF;">?</span><span style="color: #008000;">"==="</span>
<span style="color: #000000;">pop_task</span><span style="color: #0000FF;">(</span><span style="color: #000000;">do_task</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?</span><span style="color: #008000;">"==="</span>
<span style="color: #000000;">list_tasks</span><span style="color: #0000FF;">()</span>
<!--

View file

@ -0,0 +1,58 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">pq</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">PRIORITY</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">2</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">pqAdd</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">item</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- item is {object data, object priority}</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pq</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">m</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">pq</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">0</span>
<span style="color: #000080;font-style:italic;">-- append at end, then up heap</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">></span><span style="color: #000000;">0</span> <span style="color: #008080;">and</span> <span style="color: #000000;">item</span><span style="color: #0000FF;">[</span><span style="color: #000000;">PRIORITY</span><span style="color: #0000FF;">]<</span><span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PRIORITY</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">m</span>
<span style="color: #000000;">m</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">item</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">pqPop</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">qn</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pq</span><span style="color: #0000FF;">),</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">m</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">2</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">m</span><span style="color: #0000FF;"><</span><span style="color: #000000;">qn</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;"><</span><span style="color: #000000;">qn</span> <span style="color: #008080;">and</span> <span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PRIORITY</span><span style="color: #0000FF;">]></span><span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PRIORITY</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">m</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">qn</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PRIORITY</span><span style="color: #0000FF;">]<=</span><span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PRIORITY</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">m</span>
<span style="color: #000000;">m</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">m</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">2</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">qn</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">pq</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pq</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..$-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">result</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #7060A8;">set_rand</span><span style="color: #0000FF;">(</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()=</span><span style="color: #004600;">JS</span><span style="color: #0000FF;">?</span><span style="color: #000000;">5749</span><span style="color: #0000FF;">:</span> <span style="color: #000080;font-style:italic;">-- (optional!)</span>
<span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">machine_bits</span><span style="color: #0000FF;">()=</span><span style="color: #000000;">32</span><span style="color: #0000FF;">?</span><span style="color: #000000;">4601</span><span style="color: #0000FF;">:</span><span style="color: #000000;">97</span><span style="color: #0000FF;">)))</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">set</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">shuffle</span><span style="color: #0000FF;">({{</span><span style="color: #008000;">"Clear drains"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"Feed cat"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"Make tea"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">5</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"Solve RC tasks"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"Tax return"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">}})</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">pqAdd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">pqAdd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">rand</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">))])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pq</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">pqPop</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<!--

View file

@ -0,0 +1,15 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">tasklist</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">pq_new</span><span style="color: #0000FF;">(</span><span style="color: #004600;">MAX_HEAP</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">pq_add</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"Clear drains"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">},</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">pq_add</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"Feed cat"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">},</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">pq_add</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"Make tea"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">},</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">pq_add</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"Solve RC tasks"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">pq_add</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"Tax return"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">},</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">pq_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #0000FF;">{</span><span style="color: #004080;">string</span> <span style="color: #000000;">task</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">priority</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">pq_pop</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tasklist</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d: %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">priority</span><span style="color: #0000FF;">,</span><span style="color: #000000;">task</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<!--

View file

@ -0,0 +1,8 @@
/# Rosetta Code problem: http://rosettacode.org/wiki/Priority_queue
by Galileo, 05/2022 #/
include ..\Utilitys.pmt
( )
( 3 "Clear drains" ) 0 put ( 4 "Feed cat" ) 0 put ( 5 "Make tea" ) 0 put ( 1 "Solve RC tasks" ) 0 put ( 2 "Tax return" ) 0 put
sort pop swap print pstack

View file

@ -0,0 +1,17 @@
main =>
Tasks = [[3,"Clear drains"],
[4,"Feed cat"],
[5,"Make tea"],
[1,"Solve RC tasks"],
[2,"Tax return"]],
Heap = new_min_heap([]),
foreach(Task in Tasks)
Heap.heap_push(Task),
println(top=Heap.heap_top())
end,
nl,
println(Heap),
println(size=Heap.heap_size),
nl,
println("Pop the elements from the queue:"),
println([Heap.heap_pop() : _ in 1..Heap.heap_size]).

View file

@ -0,0 +1,7 @@
Tasks = [[3,"Clear drains"],
[4,"Feed cat"],
[5,"Make tea"],
[1,"Solve RC tasks"],
[2,"Tax return"]],
Heap = new_min_heap(Tasks),
println([Heap.heap_pop() : _ in 1..Heap.heap_size]).

View file

@ -0,0 +1,18 @@
# Insert item into priority queue
(de insertPQ (Queue Prio Item)
(idx Queue (cons Prio Item) T) )
# Remove and return top item from priority queue
(de removePQ (Queue)
(cdar (idx Queue (peekPQ Queue) NIL)) )
# Find top element in priority queue
(de peekPQ (Queue)
(let V (val Queue)
(while (cadr V)
(setq V @) )
(car V) ) )
# Merge second queue into first
(de mergePQ (Queue1 Queue2)
(balance Queue1 (sort (conc (idx Queue1) (idx Queue2)))) )

View file

@ -0,0 +1,18 @@
# Two priority queues
(off Pq1 Pq2)
# Insert into first queue
(insertPQ 'Pq1 3 '(Clear drains))
(insertPQ 'Pq1 4 '(Feed cat))
# Insert into second queue
(insertPQ 'Pq2 5 '(Make tea))
(insertPQ 'Pq2 1 '(Solve RC tasks))
(insertPQ 'Pq2 2 '(Tax return))
# Merge second into first queue
(mergePQ 'Pq1 'Pq2)
# Remove and print all items from first queue
(while Pq1
(println (removePQ 'Pq1)) )

Some files were not shown because too many files have changed in this diff Show more