#!/usr/bin/perl

# implementation of the heap sort algorithm for demonstration and testing
# purposes.
#
# written and © by Jan 'jast' Krüger, 2003.
# See the enclosed file COPYING for license details.

use warnings;
use strict;

# candy initialisation
my $swaps = 0;
my $compares = 0;
my $c2 = "\x1b[1;32m";
my $c1 = "\x1b[1;31m";
my $c0 = "\x1b[0;37m";

# swaps two array values
sub swap
{
	my ($ar, $a, $b) = @_[0..2];
	my $t;
	$t = $ar->[$b];
	$ar->[$b] = $ar->[$a];
	$ar->[$a] = $t;
	$swaps+=3;
}

# compares two array values
sub cmpaa
{
	my ($ar, $a, $b) = @_[0..2];
	$compares++;
	$ar->[$a] cmp $ar->[$b];
}

# compares an array value with a scalar
sub cmpav
{
	my ($ar, $a, $b) = @_[0..2];
	$compares++;
	$ar->[$a] cmp $b;
}

# compares two scalars
sub cmpvv
{
	$compares++;
	$_[0] <=> $_[1];
}

# heapifies @array[$i..$k].
# (i.e. ensures that the following requirement is fulfilled by the array
#  values $i through $k:
#      $array[int($x/2)] >= $array[$x]    for $x = 2*$i .. @$array
# only the value at $i is considered, thus downheap must be called whenever
# the heap is resized (step 1) or the root node is changed (step 2)
sub downheap
{
	my ($i, $k, $array) = @_[0..2];
	my $v = $array->[$i-1];
	my $l;
	while(cmpvv($i, int($k/2)) < 1) {
		$l = $i*2;
		$l++ if(cmpvv($l, $k) < 0 && cmpaa($array, $l-1, $l) < 0);
		last if(cmpav($array, $l-1, $v) < 1);
		$array->[$i-1] = $array->[$l-1];
		$swaps++;
		$i = $l;
	}
	$array->[$i-1] = $v;
	$swaps++;
}

sub heapsort
{
	my $array = $_[0];

	print "step 1: generating heap...\n";
	my $i = int(@$array/2);
	while(cmpvv($i, 0) > 0) {
		my ($oswp, $ocmp) = ($swaps, $compares);
		# consider the $i-th element of the array
		downheap($i, scalar @$array, $array);
		$i--;
		printf "(%3sa, %3sc)\t", ($swaps-$oswp), ($compares-$ocmp);
		print join(' ', @$array[0..($i-1)]) .' ' if($i);
		print $c2 . join(' ', @$array[$i..(@$array-1)]) ."$c0\n";
	}

	print "step 2: sorting...\n";
	$i = @$array;
	while(cmpvv($i, 1) > 0) {
		my ($oswp, $ocmp) = ($swaps, $compares);
		$compares++;
		swap($array, $i-1, 0);
		$i--;
		# root node changed, re-heap
		downheap(1,$i,$array);
		printf "(%3sa, %3sc)\t", ($swaps-$oswp), ($compares-$ocmp);
		print $c2 . join(' ', @$array[0..($i-1)]) ."$c0 " if($i);
		print join(' ', @$array[$i..(@$array-1)]) ."\n";
	}
}

sub main {
	my @array = split(//, 'abcdefgEXAMPLE5732471238');

	print "start:\t\t". join(' ', @array) ."\n";
	heapsort(\@array);
	printf "%4sa (=> \%ds), \%sc insgesamt.\n", $swaps, ($swaps/3), $compares;
	print "explanation: a = assigns, s = swaps, c = compares, ${c2}heap$c0\n";
}

main();
