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 fannkuchs1 program should:


[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;
}

[download]

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;
}

[download]
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.)

In reply to Speed/Efficiency tweaks for a fannkuch benchmark script? by thundergnat

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.