ヒープソート

数学的基礎とデータ構造 (アルゴリズムイントロダクション)のp129付近。これまで作ってきた

• ヒープ条件の維持
• ヒープの構築

を元にヒープソートを行こなう。ヒープの根を取り除いて(根は必ず一番大きくなっている性質を利用)、ヒープを再構成というのを繰り返すと、取り除いたリストがソート済みのリストになっている、という仕掛け。

use strict;
use warnings;

sub parent {
    my $i = shift;
    return int($i/2);
}

sub left {
    my $i = shift;
    return 2 * $i;
}

sub right {
    my $i = shift;
    return 2 * $i + 1;
}

sub heap_size {
    my $a = shift;
    my $length = @$a; # 配列をスカラーに代入すると長さが得られる
    return $length;
}

sub heap_print {
    sub heap_print_internal {
	my ($a, $i, $indent) = @_;
	if ($i <= @$a) {
	    print " " x $indent, @$a[$i-1], "\n";
	    &heap_print_internal($a, &left($i), $indent + 1);
	    &heap_print_internal($a, &right($i), $indent + 1);
	}
    }
    my $a = shift;
    &heap_print_internal($a, 1, 0);
}

sub max_heapify {
    my ($a, $i) = @_;
    my $l = &left($i);
    my $r = &right($i);
    my $largest = undef;
    if ($l <= heap_size($a) && @$a[$l -1] > @$a[$i -1]) {
	$largest = $l;
    } else {
	$largest = $i;
    }

    if ($r <= heap_size($a) && @$a[$r -1] > @$a[$largest -1]) {
	$largest = $r;
    }

    if ($largest != $i) {
        my $tmp = undef;
	# swap
	$tmp =  @$a[$i-1];
	@$a[$i-1] = @$a[$largest -1];
	@$a[$largest -1] = $tmp;
	
	max_heapify($a, $largest);
    }
}

sub build_max_heap {
    my $a = shift;
    foreach (reverse(1..int(@$a /2))) {
	max_heapify($a,$_);
    }
}

sub heap_sort {
    my $a = shift;
    &build_max_heap($a);
    my @result =();
    foreach (reverse(1..@$a)) { # 本には2まででよいと書いてあるけど、プログラムの戻り値としては1のほうがやりやすい
	print "[", join(",", @$a), "] -> ";
        my $tmp = undef;
	# swap
	$tmp =  @$a[0];
	@$a[0] = @$a[$_ - 1];
	@$a[$_ - 1] = $tmp;

	unshift(@result, pop(@$a));
	&max_heapify($a,1);

	print "[", join(",", @$a), "].\n";
	print "result : [", join(",", @result), "].\n";
    }
    return @result;
}

my @a = (4, 1, 3, 2, 16, 9, 10, 14, 8, 100);
print "before heap sort : [", join(",",@a), "].\n";
print "=" x 50, "\n";
my @result = &heap_sort(\@a);
print "=" x 50, "\n";
print "after heap sort : [", join(",",@result), "].\n";

実行結果。段階を踏んでいくと難しくないなあ。

/tmp% perl -w heap_sort.pl
before heap sort : [4,1,3,2,16,9,10,14,8,100].
==================================================
[100,16,10,14,4,9,3,2,8,1] -> [16,14,10,8,4,9,3,2,1].
result : [100].
[16,14,10,8,4,9,3,2,1] -> [14,8,10,2,4,9,3,1].
result : [16,100].
[14,8,10,2,4,9,3,1] -> [10,8,9,2,4,1,3].
result : [14,16,100].
[10,8,9,2,4,1,3] -> [9,8,3,2,4,1].
result : [10,14,16,100].
[9,8,3,2,4,1] -> [8,4,3,2,1].
result : [9,10,14,16,100].
[8,4,3,2,1] -> [4,2,3,1].
result : [8,9,10,14,16,100].
[4,2,3,1] -> [3,2,1].
result : [4,8,9,10,14,16,100].
[3,2,1] -> [2,1].
result : [3,4,8,9,10,14,16,100].
[2,1] -> [1].
result : [2,3,4,8,9,10,14,16,100].
[1] -> [].
result : [1,2,3,4,8,9,10,14,16,100].
==================================================
after heap sort : [1,2,3,4,8,9,10,14,16,100].