Perl Heap Sort

#!/usr/bin/perl -w

use integer;

sub heapify;

sub heapsort {
    my $array = shift;

    foreach ( my $index = 1 + @$array / 2; $index--; ) {
        heapify $array, $index;
    }

    foreach ( my $last = @$array; --$last; ) {
        @{ $array }[ 0, $last ] = @{ $array }[ $last, 0 ];
        heapify $array, 0, $last;
    }
}

sub heapify {
    my ($array, $index, $last) = @_;

    $last = @$array unless defined $last;

    my $swap = $index;
    my $high = $index * 2 + 1;

    foreach ( my $try = $index * 2;
                 $try < $last && $try <= $high;
                 $try ++ ) {
        $swap = $try if $array->[ $try ] gt $array->[ $swap ];
    }

    unless ( $swap == $index ) {
        # The heap is in disorder: must reshuffle.
        @{ $array }[ $swap, $index ] = @{ $array }[ $index, $swap ];
        heapify $array, $swap, $last;
    }
}

@array = qw(I have a holographic chocolate bar.
            No, really. I am supposed to save
            it because it is like art or something. But I am really
            hungry and I have been checking these examples all day.
            I think I deserve a reward.);

heapsort( \@array );

print "@array\n";

Related Tutorials

• « Previous page
• Next page »