Priority queue: Difference between revisions

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


===Using a stack with arrays as elements===
===Using a stack with arrays as elements===
Every insertion push item using binary search in proper position. Pop is very fast.
Every insertion push item using binary search in proper position. Pop is very fast. Cons() used for demo purposes, make a new array from a series of arrays (a=cons(a,a) add to a an a . Variable a is a pointer to array (a tuple)

<syntaxhighlight lang="m2000 interpreter">
<syntaxhighlight lang="m2000 interpreter">
Module PriorityQueue {
Module PriorityQueue {
a= ( (3, "Clear drains"), (4 ,"Feed cat"), ( 5 , "Make tea"), ( 1 ,"Solve RC tasks"), ( 2 , "Tax return"))
a= ((3, "Clear drains"), (4 ,"Feed cat"), ( 5 , "Make tea"))
a=cons(a, ((1 ,"Solve RC tasks"), ( 2 , "Tax return")))
b=stack
b=stack
comp=lambda (a, b) ->{
comp=lambda (a, b) -> array(a, 0)<array(b, 0)
=array(a, 0)<array(b, 0)
}
module InsertPQ (a, n, &comp) {
module InsertPQ (a, n, &comp) {
if len(a)=0 then stack a {data n} : exit
if len(a)=0 then stack a {data n} : exit
Line 4,541: Line 4,540:
t=2: b=len(a)
t=2: b=len(a)
m=b
m=b
while t<=b {
while t<=b
t1=m
t1=m
m=(b+t) div 2
m=(b+t) div 2
Line 4,548: Line 4,547:
b=m-1
b=m-1
m=b
m=b
}
end while
if m>1 then shiftback m
if m>1 then shiftback m
}
}
Line 4,554: Line 4,553:
n=each(a)
n=each(a)
while n {
while n
InsertPq b, array(n), &comp
InsertPq b, array(n), &comp
}
end while
n1=each(b)
n1=each(b)
while n1 {
while n1
m=stackitem(n1)
m=stackitem(n1)
Print array(m, 0), array$(m, 1)
print array(m, 0), array$(m, 1)
}
end while
\\ Peek topitem (without popping)
\\ Peek topitem (without popping)
Print Array$(stackitem(b), 1)
print Array$(stackitem(b), 1)
\\ Pop item
\\ Pop item
Stack b {
Stack b {
Read old
Read old
}
}
Print Array$(old, 1)
print Array$(old, 1)
Function Peek$(a) {=Array$(stackitem(a), 1)}
def Peek$(a)=Array$(stackitem(a), 1)
Function Pop$(a) {
Function Pop$(a) {
stack a {
stack a {
Line 4,578: Line 4,577:
}
}
}
}
Print Peek$(b)
print Peek$(b)
Print Pop$(b)
print Pop$(b)
Function IsEmpty(a) {
def IsEmpty(a)=len(a)=0
=len(a)=0
while not IsEmpty(b)
}
print pop$(b)
While not IsEmpty(b) {
end while
Print pop$(b)
}
}
}
PriorityQueue
PriorityQueue

</syntaxhighlight>
</syntaxhighlight>


Line 4,598: Line 4,594:
class obj {
class obj {
x, s$
x, s$
class:
class:
module obj (.x, .s$) {}
module obj (.x, .s$) {}
}
}
Line 4,650: Line 4,646:
Print Pop$(b)
Print Pop$(b)
}
}
}
PriorityQueueForGroups
</syntaxhighlight>

===Using a stack with pointers to Groups as elements===
Now we use pointer to group, and use of Subs and simple Functions (called using @ prefix). Also we have a global countmany (is a long type, see 0&) to check how many objects exist. We have use "as *obj" to declare a parameter to stay as pointer and to check the type (here is obj). The remove method of object called when object has to be removed. The constructor module obj called once and not exist in the final object obj (it is a part under Class: label, and this part define things for construction time only). Property toString$ is a group which return value (a string value), and we can use it with or without parameter. Because it is a group, we have to link parent properties/functions (but not modules) to get access.


<syntaxhighlight lang="m2000 interpreter">
// using pointers to objects
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++}
}
// 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"), g( 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 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, 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 as *obj, b as *obj)
=a=>x<b=>x
end function
function Peek$(a as stack)
=stackitem(a)=>toString$
end function
function IsEmpty(a)
=len(a)=0
end function
Function Pop(a)
// Group make a copy
stack a {=Group}
end function
}
}
PriorityQueueForGroups
PriorityQueueForGroups
Retrieved from "https://rosettacode.org/wiki/Priority_queue"