BeginPackage["CSM`Heap`"]

newHeap::usage = "newHeap[n] gives an empty heap with room for n elements."
upHeap::usage = "upHeap[h,k] restores the heap with a new element at
	position k."
insert::usage = "insert[h, n, v] inserts v into heap h with n elements."
downHeap::usage = "downHeap[h,n] restores the heap condition at the root."
delete::usage = "delete[h,n] deletes the largest element from heap h with
	n elements."
HeapSort::usage = "HeapSort[list] sorts list using a heap."
HeapSortList::usage = "HeapSortList[list] returns the intermediate steps
	of HeapSort[list]."
HeapPlot::usage = "HeapPlot[heap, k] draws a diagram of a heap."

Begin["`Private`"]

p[k_Integer?Positive] := Floor[k/2]    (* Predecessor node *)

newHeap[n_Integer?NonNegative] := Table[ Null, {n} ]

SetAttributes[ upHeap, HoldFirst ]

upHeap[h_Symbol, k0_] :=
    Module[{v = h[[k0]], k = k0},
        While[ p[k] > 0 && h[[ p[k] ]] < v,
            h[[ k ]] = h[[ p[k] ]];
            k = p[k]
        ];
        h[[k]] = v;
        h
    ]

SetAttributes[ insert, HoldAll ]

insert[h_Symbol, n_Symbol, v_] := (h[[++n]] = v; upHeap[h, n]; h)

SetAttributes[ downHeap, HoldFirst ]

downHeap[h_Symbol, n_] :=
    Module[{v = h[[1]], i = 1, j},
        While[ i <= n/2,
            j = 2i;
            (* find larger successor *)
            If[ j < n && h[[ j ]] < h[[ j+1 ]], j++ ];
            If[ v > h[[ j ]], Break[] ]; (* ok *)
            h[[ i ]] = h[[ j ]];
            i = j
        ];
        h[[ i ]] = v;
        h
    ]

SetAttributes[ delete, HoldAll ]

delete[h_Symbol, n_Symbol] :=
    Module[ {v = h[[1]]},
        h[[1]] = h[[n--]];
        downHeap[h, n];
        v
    ]

HeapSort[a_List] :=
    Module[{n = 0, h = a, i},
        Do[ insert[ h, n, h[[i]] ], {i, 1, Length[a]} ];
        Do[ h[[i]] = delete[ h, n ], {i, Length[a], 1, -1} ];
        h
    ]

HeapSortList[a_] :=
    Module[{n = 0, h = a, res = {a}},
        Do[ insert[ h, n, a[[i]] ]; AppendTo[res, h], {i, 1, Length[a]} ];
        Do[ h[[i]] = delete[ h, n ]; AppendTo[res, h], {i, Length[a], 1, -1} ];
        res
    ]



diskr = 0.4
maxnode = 7
margin = 0.5
diskbg = 0.85


plot0[ heap_, k_, i_, stufe_, nextx_ ]/; i > k := {nextx, nextx+1, {}}
plot0[ heap_, k_, i_, stufe_, nextx_ ] :=
    Module[{wx, nextl, nextr, wl, wr, gl, gr, g = {}},
	If[ 2i <= k,
	    {wl, nextl, gl} = plot0[heap, k, 2i, stufe-1, nextx];
	     wx = nextl;
	     AppendTo[g, Line[{ {wl, stufe-1}, {wx, stufe} }]];
	     AppendTo[g, gl],
	    (* else *) wx = nextx
	];
	If[ 2i + 1 <= k,
	    {wr, nextr, gr} = plot0[heap, k, 2i + 1, stufe-1, wx+1];
	     AppendTo[g, Line[{ {wr, stufe-1}, {wx, stufe} }]];
	     AppendTo[g, gr],
	   (* else *) nextr = wx+1
	];
	g = Join[g,
		{ {GrayLevel[diskbg], Disk[ {wx, stufe}, diskr ]},
		  Circle[{wx, stufe}, diskr ],
		  Text[ heap[[i]], {wx, stufe} ]
		} ];
	{wx, nextr, g}
    ]

HeapPlot[ heap_, k_, opts___ ] /; 0 <= k <= Length[heap] :=
    Module[{wx, nextx, g, x0, x1},
	{wx, nextx, g} = plot0[heap, k, 1, 0, 0];
	g = Prepend[ g, Line[{{wx, 0}, {wx, 1}}] ];
	If[ nextx > maxnode,
	    {x0, x1} = {0, nextx-1},
	    {x0, x1} = {0 - (maxnode-(nextx-1))/2,
			nextx-1 + (maxnode-(nextx-1))/2}];
	Show[ Graphics[g], opts, AspectRatio->Automatic,
	      PlotRange->{{x0-margin, x1+margin}, All} ]
    ]

End[]

EndPackage[]
