[Unicon-group] Another heap implementation

[Majorinc, Kazimir]

I have made few heaps procedures, almost same like those in pqueue.icn in 
library, except that function/procedure and data that define order of 
elements is enclosed in heap instead of record with priority field as it is 
in pqueue.icn . Perhaps someone will find some use of that. Or some bug.

# K.Majorinc 2004. GNU GPL
record heap_type(L, f, x) # type of heap
procedure heap(S, f, x)  # initalization of heap
  local H
  H:=heap_type(list(), f, x)
  if \S then every heap_insert(H, !S)
  return H
  end
procedure heap_all(H) # generates all elements in heap
  temp:=heap(,H.f, H.x)
  temp.L:=copy(H.L)
  while heap_card(temp)>0 do suspend heap_get(temp)
  end
procedure heap_card(H) # returns number of elements on heap
  return *(H.L)
  end
procedure heap_get(H) # deletes and return topmost element in heap
  local up, down, result
  while *H.L>0 do
  { (H.L)[up:=1]:=:(H.L)[*(H.L)]
    result:=pull(H.L)
    while (down := 2 * up) <= (*H.L) do
      { if H.f(H.L[down+1], H.x) < H.f(H.L[down], H.x) then down+:=1
        if H.f(H.L[up],H.x)>(H.f)(H.L[down],H.x) then (H.L)[up]:=:(H.L)[down]
        up:=down
      }
    return result
  }
  end
procedure heap_insert(H,x) # insert element in heap, respecting order
  local i
  put(H.L,x); i:=*H.L
  while  H.f(H.L[1<i],H.x) < H.f(H.L[i/2],H.x )& ( H.L[i]:=:H.L[i/2] )& 
(i/:=2)
  end

procedure heap_demo() # demonstration and test
  local H, j, x
  write("Triplets, sorted by 2nd coordinate")
  write("==============")
  H:=heap(, heap_demo3, 2);   #heap_demo3 is projection
  write("Inserted:"); every j:=1 to 5 do {heap_insert(H,x:=[j,?0,j]); 
write(x[1],",  ",x[2],",  ",x[3])}
  write("All generated:");    every x:=heap_all(H) do write(x[1],", 
",x[2],", ",x[3])
  write("Get:");   while  heap_card(H)>0 do {x:=heap_get(H); write(x[1],", 
",x[2],", ",x[3]) }
  write("Size of heap:");   write( heap_card(H)  )

  write("Heap of reals, sorted by their own value")
  write("==============")
  H:=heap(,1)
  write("Inserted:");   every j:=1 to 5 do {heap_insert(H,x:=?0); write(x)}
  write("All generated:");   every x:=heap_all(H) do write(x)
  write("Get:");    while  heap_card(H)>0 do {x:=heap_get(H); write(x) }
  write("Size of heap:");   write( heap_card(H)  )
  write("Heap of reals, sorted by inverse order.")
  write("==============")
  H:=heap(,"*",-1)
  write("Inserted:");   every j:=1 to 5 do {heap_insert(H,x:=?0); write(x)}
  write("All generated:");   every x:=heap_all(H) do write(x)
  write("Get:");   while  heap_card(H)>0 do {x:=heap_get(H); write(x) }
  write("Size of heap:");   write( heap_card(H)  )
  write("Heap of reals, minimal are those closest to 1/2.")
  write("==============")
  H:=heap(,heap_demo2)
  write("Inserted:");   every j:=1 to 5 do {heap_insert(H,x:=?0); write(x)}
  write("All generated:");   every x:=heap_all(H) do write(x)
  write("Get:");  while  heap_card(H)>0 do {x:=heap_get(H); write(x) }
  write("Size of heap:");  write( heap_card(H)  )
  write("Heap of reals, sorted by their own value, non-empty start")
  write("==============")
  H:=heap([0.1,0.2,0.3,0.4,0.5], 1)
  write("Inserted:");   every j:=1 to 5 do {heap_insert(H,x:=?0); write(x)}
  write("All generated:");   every x:=heap_all(H) do write(x)
  write("Get:");    while  heap_card(H)>0 do {x:=heap_get(H); write(x) }
  write("Size of heap:");   write( heap_card(H)  )
  end
procedure heap_demo2(x); return abs(x-0.5); end # internal use
procedure heap_demo3(x,d); return x[d]; end # internal use
procedure main()
heap_demo()
end


----
Kazimir Majorinc, Zagreb, Croatia