RosettaCodeData/Task/Priority-queue/M2000-Interpreter/priority-queue-4.m2000

124 lines
3.6 KiB
Plaintext

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