Speed/Efficiency tweaks for a fannkuch benchmark script?

[thundergnat]

I was idly looking through The Computer Language Shootout Benchmarks and was mildly suprised at how slow many of the Perl implementations were in relation to other languages. In investigating more closely, it is apparent that most of the perl code there is basically C and Fortran written in Perl. (Without the benefit of inlining.) No wonder it doesn't fare very well.

In the implementation FAQ it states "Use the same algorithm and data structures.[In each implemantation.] As-far-as possible the languages should be doing the same operations. [...] The [...] programs often seem naive and unidiomatic."

It discourages using language specific idioms and clever programmer tricks to increase performance... What fun is that? ;-)

For amusements sake, I decided to try to rewrite one more efficiently, and selected the fannkuch benchmark.

The fannkuchs¹ program should:

• "Take a permutation of {1,...,n}, for example: {4,2,1,5,3}.
• "Take the first element, here 4, and reverse the order of the first 4 elements: {5,1,2,4,3}.
• "Repeat this until the first element is a 1, so flipping won't change anything more: {3,4,2,1,5}, {2,4,3,1,5}, {4,2,3,1,5}, {1,3,2,4,5}.
• "Count the number of flips, here 5.
• "Do this for all n! permutations, and record the maximum number of flips needed for any permutation for n = 1..10.
• Write the maximum number of flips and the sequences that required them. (Note: this is different from the benchmark site. They want the first thirty permutations returned instead of the max flip sequences, which locks you into using a specific permutator and is less interesting. I think the actual sequences that require the maximum flips is more useful information.)

[1] Fannkuch is an abbreviation for the German word Pfannkuchen, or pancakes, in analogy to flipping pancakes.

The original, "C written in Perl" code, lightly modified to return the max sequences instead of the first 30 permutations and do some timings: (No warnings, no strict, and wouldn't pass them if they were there.)

use Time::HiRes qw( gettimeofday tv_interval );

for my $num(1..10){
my @start_time = gettimeofday();
print "Pfannkuchen($num) = ".fannkuch ($num)." for:\n";
print sort @max_sequence;
my @end_time = gettimeofday();
print tv_interval ( \@start_time, \@end_time )," elapsed seconds.\n\n"
+;
};

sub fannkuch {
    my $n = shift;
    my @p;
    my @q;
    my $tmp;
    my $maxflips = 0;
    my $flips;

    for ($i=0; $i < $n; $i++) { $p[$i] = 1 + $i; }

  BRK: for (;;) {

        if ($p[0] != 1) {

            @q = @p;

            for ($flips = 0; ($k = $q[0]) != 1; $flips++) {
                for ($k--,$i=0; $i < $k; $i++, $k--) {
                    $tmp = $q[$i];
                    $q[$i] = $q[$k];
                    $q[$k] = $tmp;
                }
            }
            if ($flips > $maxflips) {
                $maxflips = $flips;
                @max_sequence = ();
            }
            push @max_sequence, join '', @p,"\n" if ($maxflips eq $fli
+ps);
        }

        $k = $j = 0;
        for ($i=1; $i < $n; $i++) {
            $j = $i if ($p[$i-1] < $p[$i]);
            $k = $i if ($j && $p[$i] > $p[$j-1]);
        }
        last BRK if (!$j);

        $tmp = $p[$j-1];
        $p[$j-1] = $p[$k];
        $p[$k] = $tmp;

        for ($i=$j,$j=$n-1; $i < $j; $i++, $j--) {
            $tmp = $p[$j];
            $p[$j] = $p[$i];
            $p[$i] = $tmp;
        }
    }

    return $maxflips;
}

And here's my whack at idiomatic, strict and warnings clean, slightly more efficient code:

Permutation algorithm blatently stolen from robin's journal.

use warnings;
use strict;
use Time::HiRes qw( gettimeofday tv_interval );

my $maxflips = 0;
my @max_sequence;

for my $num ( 1 .. 10 ) {
    my @start_time = gettimeofday();
    @max_sequence = ();
    print "Pfannkuchen($num) = " . fannkuch( [ 1 .. $num ] ) . " for:\
+n";
    print sort @max_sequence;
    my @end_time = gettimeofday();
    print tv_interval ( \@start_time, \@end_time ), " elapsed seconds.
+\n\n";
}

sub fannkuch {
    my ( $aref, $level ) = ( @_, 0 );
    my ( $index, $copy, $ok ) = ( $level, [@$aref], $level + 1 == @$ar
+ef );
    do {
        if ($ok) {
            if ( $copy->[0] != 1 and $copy->[-1] != @$copy ) {
                my @q = @$copy;
#                my ( $i, $k, $flips );
                my ( $k, $flips );
                for ( $flips = 0 ; ( $k = $q[0] ) != 1 ; $flips++ ) {
#                    for ( $k--, $i = 0 ; $i < $k ; $i++, $k-- ) {
#                       @q[ $i, $k ] = @q[ $k, $i ];
#                    }
                    @q[ 0 .. $k-1 ] = reverse @q[ 0 .. $k-1 ];
                }
                if ( $flips > $maxflips ) {
                    $maxflips     = $flips;
                    @max_sequence = ();
                }
                push @max_sequence, join '', @$copy, "\n"
                  if ( $maxflips == $flips );
            }
        }
        else {
            fannkuch( $copy, 1 + $level );
        }
        @$copy[ $index - 1, $index ] = @$copy[ $index, $index - 1 ]
          if $index != 0;

    } while $index-- > 0;
    return $maxflips;
}

Update: Oops. Deleted a few extreaneous lines.
Update 2: Modified flipping algorithm to be more perlish. (Commented out original lines.)

This is nearly twice as fast as the original but still has room for improvement I'm sure. (My Perl skills are modest at best.) Can anyone suggest any other speed/efficiency tweaks? (Other than "Write it in C or Fortran". I know, if I am looking for raw performance, Perl is likely not the way to go. This is just a programming excercise.)