#!/usr/bin/perl

sub qbsort {
    qbsort_quick( $_[0], 0, $#{ $_[0] }, defined $_[1] ? $_[1] : 10 );
    bubblesmart( $_[0] ); # Use the variant that's fast for almost sorted data.
}

# The first half of the quickbubblesort: quicksort.
# A completely normal quicksort (using median-of-three)
# except that only partitions larger than $width are sorted.

sub qbsort_quick {
    my ( $array, $first, $last, $width ) = @_;
    my @stack = ( $first, $last );

    do {
        if ( $last - $first > $width ) {
            my ( $last_of_first, $first_of_last ) =
                partitionMo3( $array, $first, $last );

            if ( $first_of_last - $first > $last - $last_of_first ) {
                push @stack, $first, $first_of_last;
                $first = $last_of_first;
            } else {
                push @stack, $last_of_first, $last;
                $last = $first_of_last;
            }
        } else { # Pop.
            ( $first, $last ) = splice @stack, -2, 2;
        }
    } while @stack;
}

sub partitionMo3 {
    my ( $array, $first, $last ) = @_;

    use integer;

    my $middle = int(( $first + $last ) / 2);

    # Shuffle the first, middle, and last so that the median
    # is at the middle.

    @$array[ $first, $middle ] = @$array[ $middle, $first ]
        if ( $$array[ $first ] gt $$array[ $middle ] );

    @$array[ $first, $last ] = @$array[ $last, $first ]
        if ( $$array[ $first ] gt $$array[ $last ] );

    @$array[ $middle, $last ] = @$array[ $last, $middle ]
        if ( $$array[ $middle ] lt $$array[ $last ] );

    my $i = $first;
    my $j = $last - 1;
    my $pivot = $$array[ $last ];

    # Now do the partitioning around the median.

 SCAN: {
        do {
            # $first <= $i <= $j <= $last - 1
            # Point 1.

            # Move $i as far as possible.
            while ( $$array[ $i ] le $pivot ) {
                $i++;
                last SCAN if $j < $i;
            }

            # Move $j as far as possible.
            while ( $$array[ $j ] ge $pivot ) {
                $j--;
                last SCAN if $j < $i;
            }

            # $i and $j did not cross over,
            # swap a low and a high value.
            @$array[ $j, $i ] = @$array[ $i, $j ];
        } while ( --$j >= ++$i );
    }
    # $first - 1 <= $j <= $i <= $last
    # Point 2.

    # Swap the pivot with the first larger element
    # (if there is one).
    if( $i < $last ) {
        @$array[ $last, $i ] = @$array[ $i, $last ];
        ++$i;
    }

    # Point 3.

    return ( $i, $j );   # The new bounds exclude the middle.
}

sub bubblesmart {
    my $array = shift;
    my $start = 0;        # The start index of the bubbling scan.
    my $ncomp = 0;        # The number of comparisons.
    my $nswap = 0;        # The number of swaps.

    my $i = $#$array;

    while ( 1 ) {
        my $new_start;    # The new start index of the bubbling scan.
        my $new_end = 0;  # The new end index of the bubbling scan.

        for ( my $j = $start || 1; $j <= $i; $j++ ) {
            $ncomp++;
            if ( $array->[ $j - 1 ] gt $array->[ $j ] ) {
                @$array[ $j, $j - 1 ] = @$array[ $j - 1, $j ];
                $nswap++;
                $new_end   = $j - 1;
                $new_start = $j - 1 unless defined $new_start;
            }
        }
        last unless defined $new_start; # No swaps: we're done.
        $i     = $new_end;
        $start = $new_start;
    }
}

@array = qw(Why are there no B batteries?  Wait a minute.  Are there even A batteries?);

qbsort( \@array );

print "@array\n";
