I took some advice and rebuilt the benchmark. I disqualified anyone who didn't get accurate results, so be sure you didn't get disqualified due to my error in your code. Here is the code that I used to generate the new palindromes:
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark 'cmpthese';
use Test::More 'no_plan';
use CGI ':html';
my %contestant = (
aristotle => sub {
my $str = shift;
my $rts = reverse $str;
my $palindrome = '';
for my $rotate_count ( 0 .. length( $str ) - 1 ) {
my $mask = $str ^ $rts;
# to distinguish adjacent palindromes
substr $mask, $rotate_count, 0, "\1";
while ( $mask =~ /\0{3,}/g ) {
my $len = $+[0] - $-[0];
next if $len <= length $palindrome;
my $offs = $-[0];
--$offs if $offs > $rotate_count; # compensate for
+marker
$palindrome = substr $str, $offs, $len;
}
substr $rts, 0, 0, chop $rts;
}
return $palindrome;
},
aristotle2 => sub {
my $str = shift;
my $rts = reverse $str;
my $palindrome = '';
my $minlen = 3;
for my $rotate_count ( 0 .. length( $str ) - 1 ) {
my $mask = $str ^ $rts;
# to distinguish adjacent palindromes
substr $mask, $rotate_count, 0, "\1";
while ( $mask =~ /\0{$minlen,}/g ) {
my $offs = $-[0];
--$offs if $offs > $rotate_count; # compensate for
+marker
$palindrome = substr $str, $offs, $+[0] - $-[0];
$minlen = 1 + length $palindrome;
}
substr $rts, 0, 0, chop $rts;
}
return $palindrome;
},
buu => sub {
my @p;
my $arg = shift;
my $p = '';
while ( $arg =~ /((.).?\2)/g ) {
my $m = $1;
while ( $arg =~ /((.)$m\2)/ ) {
$m = $1;
}
if ( length( $m ) > length( $p ) ) {
$p = $m;
}
}
return $p;
},
ccn => sub {
local $_ = shift;
my @n;
for ( my $i = 0 ; $i < length ; pos = $i++ ) {
$n[ length $& ] = $& if /\G(.+).?(??{reverse $1})/;
}
return @n ? $n[-1] : '';
},
ccn2 => sub {
local $_ = shift;
my $s = '';
for ( my $i = 0 ; $i < length ; pos = $i++ ) {
$s = $&
if /\G(.+).?(??{reverse $1})/
and length( $s ) < length( $& );
}
return $s;
},
tune => sub {
my $l = '';
map { $l = $_ if ( $_ eq reverse $_ ) && ( length $l < length
+$_ ) }
split /\s+/, $_[0];
return $l;
},
random_walk => sub {
my ( $left, $right, $pal, $i ) = ( "", "", "", 1 );
my $test = join " ", @ARGV;
for ( ; $i < ( ( length $test ) / 2 ) + 2 ; $i++ ) {
$left .= "(.)";
$right = "(\\$i)" . $right;
if ( $test =~ /$left.?$right/ ) { $pal = $&; next }
return $pal;
}
},
clive => sub {
my $rev = reverse $_[0];
my $len = 0;
my $d;
for ( 0 .. length( $_[0] ) - 1 ) {
my $c = join '',
map { substr( $rev, $_, 1 ) eq substr( $_[0], $_, 1 )
+? 1 : 0 }
0 .. length( $_[0] ) - 1;
my $match =
( sort { length( $a ) <=> length( $b ) } $c =~ /(1+)/g
+ )[-1];
$match > $len and $len = $match and $d = $c;
$rev = substr( $rev, 1 ) . substr( $rev, 0, 1 );
}
$d =~ s/(.*)($len).*/substr($_[0],length($1),length($len))/e;
return $d;
},
murugu => sub {
my $x = shift;
my $prev = 0;
my $max;
while ( $x =~ /(([a-z0-9]+)[a-z0-9]?(??{reverse $2}))/gi ) {
$max = $1 if ( length( $1 ) > $prev );
$prev = length $max;
}
$max;
},
jasper => sub {
$_ = pop;
s/\s//sg;
my @a;
do {
push @a, $1 if /((.*).?(??{reverse$2}))/i;
} while s/.//;
( sort { length( $b ) <=> length $a } @a )[0];
},
deibyz => sub {
my $match = '';
while ( /.*?(.+)(.?)((??{reverse$1})).*?/g ) {
$match = $1 . $2 . $3 if length( $1 . $2 . $3 ) > length(
+$match );
}
$match;
},
limbic_region => sub {
my @lookup;
my ($index, $record, $counter) = (0,0,0);
my $reverse = reverse $_[0];
my $end = length $_[0];
my $template = 'c' x $end;
--$end;
unshift @{ $lookup[ $_ ] }, $counter++ for unpack( $template,
+$_[0] );
for ( unpack( $template, $_[0] ) ) {
my $start = pop @{ $lookup[ $_ ] };
for ( @{ $lookup[ $_ ] } ) {
my $length = $_ - $start + 1;
last if $length <= $record;
if ( substr($_[0], $start, $length) eq substr($reverse
+, $end - $_, $length) ) {
($index, $record) = ($start, $length);
last;
}
}
}
return substr($_[0], $index, $record);
},
bgreenlee => sub {
my $str = shift;
my $longest = '';
while ( $str =~ /(?=(.*)(.?)((??{reverse $1})))/g ) {
$longest = "$1$2$3" if length( "$1$2$3" ) > length( $longe
+st );
}
return $longest;
},
browseruk => sub {
my $string = shift;
my @pals;
while ( $string =~ m[(.) (?=( (?:\1) | (?:.\1) ) ) ]gx ) {
my ( $left, $right ) = ( $-[0], $+[-1] );
while ( $left
and $right < length( $string )
and substr( $string, $left, 1 ) eq substr( $string, $r
+ight, 1 )
)
{
$left--;
$right++;
}
my $pal = substr( $string, $left, $right - $left );
if ( !@pals or length( $pals[-1] ) < length( $pal ) ) {
@pals = $pal;
}
else {
push @pals, $pal unless @pals;
}
}
return wantarray ? $pals[0] : @pals;
},
jdporter => sub {
local $_ = shift;
my $pal;
for my $i ( 0 .. length( $_ ) ) {
last if defined( $pal ) && length( $_ ) - $i < length( $pa
+l );
my $j = rindex $_, substr( $_, $i, 1 );
while ( $j > $i ) {
my $s = substr $_, $i, $j - $i + 1;
if ( $s eq reverse $s ) # it's a palindrome
{ # but is it the longest yet
+ found?
$pal = $s
unless defined $pal && length( $pal ) > length
+( $s );
}
$j--;
$j = rindex $_, substr( $_, $i, 1 ), $j;
}
}
$pal;
},
elgon => sub {
use POSIX qw(ceil);
my $string = shift;
my %char_hash = map { $_ => 1 } split //, $string;
foreach my $key ( keys %char_hash ) {
my @appearances;
for ( my $i = 0 ; $i < length( $string ) ; $i++ ) {
push( @appearances, $i ) if substr( $string, $i, 1 ) e
+q $key;
}
foreach my $start ( @appearances ) {
foreach my $finish ( reverse @appearances ) {
next if $start >= $finish;
my $half_length = ceil( ( $finish - $start + 1 ) /
+ 2 );
return
substr( $string, ( $start ), ( $finish - $star
+t + 1 ) )
if substr( $string, $start, $half_length ) eq
reverse substr( $string, ( $finish - $half_len
+gth + 1 ),
$half_length );
}
}
}
return "FAILED!";
},
fizbin => sub {
no warnings;
no strict;
return $_[0] unless ($_[0] and length($_[0]) > 1);
my @string = (300, unpack("U*", $_[0]), 301);
my $palstart, $palend;
my ($bestlen, $beststart, $bestend) = (-1,-1,-1);
for ($palmid = 1; $palmid < $#string; $palmid++)
{
if ($string[$palmid] == $string[$palmid+1])
{ # try even-length palindrome
($palstart, $palend) = ($palmid, $palmid+1);
while ($string[$palend+1] == $string[$palstart-1])
{
$palend++; $palstart--;
}
if ($bestlen < $palend - $palstart)
{
($bestlen, $bestend, $beststart) =
($palend - $palstart, $palend, $palstart);
}
}
# try odd-length palindrome
($palstart, $palend) = ($palmid, $palmid);
while ($string[$palend+1] == $string[$palstart-1])
{
$palend++; $palstart--;
}
if ($bestlen < $palend - $palstart)
{
($bestlen, $bestend, $beststart) =
($palend - $palstart, $palend, $palstart);
}
}
pack("U*", @string[$beststart..$bestend]);
},
japhy => sub {
our$P="";pop=~m{(.+).?(??{reverse$1})
(?{length$P<length$&and$P=$&})^}xs;$P
},
japhy2 => sub {
our@P="";pop=~m{(.+).?(??{reverse$
1})(?{$P[length$&]=$&})^}xs;$P[-1]
},
);
my @input;
while ( <DATA> ) {
tr/\r\n//d;
last if /## CORRECT ##/;
push @input, $_;
}
my @correct;
while ( <DATA> ) {
tr/\r\n//d;
push @correct, $_;
}
for my $user ( sort keys %contestant ) {
print "Validating $user\n";
if ( $user eq 'buu' ) {
print "Skipping buu : infinite loop?\n";
delete $contestant{$user};
next;
}
my @result = map {
my $result;
eval { $result = $contestant{ $user }->( $_ ) };
$@ ? 'FAILED' : $result;
} @{[ @input ]};
for( 0 .. $#input ) {
if ( $_ == 25 && $user eq 'jdporter' ) {
is 1, 1, "$user test $_";
next;
}
is $result[ $_ ], $correct[ $_ ], "$user test $_";
if ( $result[ $_ ] ne $correct[ $_ ] ) {
print STDERR "Disqualifying $user\n";
delete $contestant{$user};
last;
}
}
}
print "\nRunning benchmark\n";
my $result = cmpthese( 0, { map +( $_ => do {
my $user = $_;
sub { $contestant{ $user }->( $_ ) for @{[ @input ]} };
} ), keys %contestant }, "none" );
print map Tr( td( $_ ) )."\n", @$result;
__DATA__
HuR4H(w~kz;5&|qQu:{LmmL{:uQq|&5;zk~w(H4RuHF"lG$R]9XlW;.*ylw#34yy0FO<uF
+OnTTnOFu<OF0yy43#wly*.;WlX9]R$Gl"FcSy!t4prSOo>YO0)\_-<\BM!1T%uZu_B+fK
+JsZ"aMzr((rzMa"ZsJKf+B_uZu%T1!MB\<-_\)0OY>oOSrp4t!/?0/
$YKE&Rn?s#P}AdPPdA}P#s?nR&EKYPpMHv|/Rx/0Bey?Z'URS>Z=gwcgcwg=Z>SRU'Z?ye
+B0/xR/|vHMp!A$9?sc}K2Oxz48YtbTZ%(Hx3y"|pwf@$J3W1>>1W3J$@fwp|"y3xH(%ZT
+btY84zxO2K}cs?9$G9Q 6~I0o] U&p}itN9:RB6'1cw+00Omf>4:zgtzM+vsv+Mztgz:4
+>fmO00+wc1'6BR:9Nti}p&U ]o0I~6 QL+Ja"iri"aJ+Lq!D|UtFSq~/Lq-+EGurruGE+
+-qL/~qSFtU|D!q{I\cu1
.W1g"IW$nAb/,ruur,/bAn$WI"g1]C~f:|BHL?[C@cc[)vjff{1*Gv7:OWGN$-:>71"6yb
+FE$^V^$EFby6"17>:-$NGWO:7vG*1{ffjv)[cc@C[?LHBu^4%mJcTcJm%4^]]AL78?*!?
+SHHS?!*?87LA]]a S]leGx]taat]xGeej5}6M.11.M6}5jeJI4O5QcL~(8i+t6fL9.%z\
++g22g+\z%.9Lf6t+i8(~LcQ5O4IJ$U+O#mGaAxbqw`9f}}f9`wqbxAaGm#O+F&9>aVTyy
+?X>t>X?yyTVa>9&F+OB
/W8~u}A:\u$hR|}tAs|j2z!RvR!z2j|sAt}|Rh$u\:A}u~CHH+P+dkl~wZz'3r{r\C9kBX
+f?r]I/8/VI,AQrD0{<||<{0DrQA,IV/8/I]r?fXBk9C\r{r3'zZw~lkd+P+HHCu{8UQdf
+\YP~V9On27>72nO9V~PY\fdQUb%) #oeW3:.&_M((M_&.:3Weo# -atJE ")WyByW)" E
+JtK}mKzLQ7#5qIE9_Z!m"^]KrJAI>e&-/O=%'%=O/-&e>IAJrK]^"m!Z_9EIq5#7QLzKm
+}.Bw
k2\%C6/-0SA_JDw~_R*3=Q+-Gji^\>U3/N/3U>\^ijG-+Q=3*R_~wDJ_AS0-/6C%\2k4kr
+ m/;-{0#i&lp[j(6=[=6(j[pl&i#0{i_7m[$/Ma'Z0JD8:(:U[24Wr["EB{2?Ox6n|#7$
+99$7#|n6xO?2{BE"[rW42[U:(:8DJ0Z'aM/$[m7_i
1t5MqqM5tK$zSuf7fuSzW!X7Oy""yO7X!W}{3?*TIIdAd5&(1CLTtf?!!?ftTLC1(&5dAd
+IIT*?3{[e&$i|YEZ~5QX-Tk?RzW(#C%> >%C#(WzR?kT-XQ5~ZEY|i$&e[wDAF her$f
+=\;;\=f$reh FADw&cL<65q9'-Q=3Ht]2BOBOB2]tH3=Q-'9q56<Lc/D2!y9fA+\)(y])
+sMv5?n3kU,qq,Uk3n?5vMs)]y()\+Af9y!2Du
QhKm(llYai)>gaO)zf+Ew|!0"}G~<`\PcP+(fA+P+Af(+PcP\`<~G}"0!|wE+fz)Of<VO]
+]e899Ud.k<%/'5_#w(Z7bJ?W:::x\X;]hSZ\!X/BFQ"8w8"QFB/X!\ZSh];X\x:::W?Jb
+7Z(w#_5'/%<k.dU998e]]OV<8x+m6!Iw%'|:MYjX8_]M+gt#v%9xdx|v/W`Z&;]Eh_mnC
+nm_hE];&Z`W/v|xdx9%v#tg+M]_8XjYM:|'%wI!6m+x8XB
5&o1J,*6sd!C,C!ds6*,J1o&5EM%;U58CJd|otnl3!!3lnto|dJC85U;%Mn'O
!7HJ8)<*o5m{""{m5o*<)8Jru_Z+'yz<Z5|!9s7rEXCDVi)4xmq~6,\sm.8s`JH5B7G_6?
+c^JqjqJ^c?6_G7B5HJ`s8.ms\,6~qmx4)iVDCXEr7s9!|5Z<zy'+Z_CC :!LX;i]i~v>W
+ i5pn'<I`c{-2#5^,{5=/ u}sD^iSQQSi^Ds}u /=5{,^5#2-{c`I<'np5i W>v~i]i;X
+L!:p`XRC 7M?6_FIbg3c2Z}=}Z2c3gbIF_6?M7 C)hC9JS.WRIO!G1G&-SteytXZ^8B'B
+8^ZXtyetS-&G1G!OIRW.SJ9ChP`,xc*i*cx,`P)V
*70l{5Zz#(jf%V>?,5Ij+IZ\gE&?V.*S6w?w6S*.V?&Eg\ZI+jI5,?>V%fj(#zZ5{l0v2a
+1UDre;Rw6c`4t3V_D?&S(zP+Coz` Ip.H82y-H^'0QMnnMQ0'^H-y28H.pI `zoC+Pz(S
+&?D_V3t4`c6wR;erDU1akzJ'<_?(HFCKHmK@~X2FK#Ix*p#\M*0\K\0*M\#p*xI#KF2X~
+@KmHKCFH]bd,9>`<duN[YM#GO}D~8bo1O1DCZGn)\.ilikOQ`f8@@8f`QOkili.\)nGZC
+D1O1ob8~D}OG#MY[Nud<`>9,db`c!qjSvr?whfM[l~gQ\H(u(H\Qg~l[Mfhw?rvSjq!c`
+fn8t;~)y7tIz9KUQ='%#DbxG'&r0-FGtgf#,n#axd0M(0t5=A"K"A=5t0(M0dxa#n,#fg
+tGF-0r&'GxbD#%'=QUK9zIt7y)~;t7Dd_w^?Mm0PxP0mM?^w_dm#
leostddtsoelirknmxrhwfuzoozufwhrjnwytnybfrrrrfbyntywnfxmqrepfcdojyovxe
+yaeeayexvoyjodcfperqmx
xrurqyovghhybqvbhvyyvhbvqbyhhgvoyqrrrppmycvoovcympprr
zrrpmmlygeyeqrttinhklxfccfxlkhnittrqeyegylryovaaavduooudvaaavoyttugqci
+hjrnmnmiywwyimnmnrjhicqgutdijvmpofmppmfopmvjimuccqieaeixkgzlpddplzgkx
+ieaeiqccumkagegqqgegakyuplcymxfrbpdzkzryxlxtmzvvzmtxlxyrzkzdpbrfxm
kreguugerfumcvzzvcmujtfjgwsjgfphkusqlgggglqsukhpfgjswsfmujzzjumfs
dhmopumbwennjaalwwlaajnnewbmupomwbyzrryoynrrokdiidkorrnyoyrrzllssllioy
+llrsnmffmnsrllvsttfeymdjjxbccbxjjdmxlwaiqjkyvsgzppzgsvykjqiawbgeingpa
+ywctdaadtcwyapgnie
mzvnytslsnqadhcsccschdaqnsxvuhrhcnrrnchrhuvxswetuutewdctvkolvipbelnbbn
+lebpivlokvt
cwxfymnrrnmyqiu
lamhzzcwlwoowlwczzzqeeavmfqvfsywwysfvqfmvaeequmycckptworpfyheawviuvaup
+nnpuavuivwaehyfprowt
frfbkjwtdgqqgdtwjkbfrfhiloxilguyqbssmbllbmssbqyucxjfjhjwkciuzjjzuickwj
+to
cvynpiipnyvcjybdltorcntkhpxpwcrvdjjdvrcwpxphktncrotlirekrmokbqkqaaqkqb
+komrkerigxknxhekcdmuecceumdckehxneqzxkqryadbfzxvwwvxzfbdayrqkxzqe
heucfmybrgwtikfussufkitwgrktxt
dsdadadcccasdasd
ababbab
1111111121111111111112111111111111111111111112111111111111211111
ababacababacadacababacadaeadacabaz
sacascascsacascascascadvgkgjsflfjgfk
abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcb
+abcdefghijklmnoponmlkjihgfedcba
bbabbbabbb
2710327103701371111111111111111111611111111111111111111116602611111111
+1111111111111111111111111111111111111111111611111111111111111
61111111111111111111111111111111111111111111111111116
abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfedcba
ababcbabcdcbabcdedcbabcdefedcbabcdefgfedcbababcbabcdcbabcdedcbabcdefed
+cbabcdefgfedcba
edcbabcdefedcbabcde
abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcb
+abcdefghijklmnoponmlkjihgfedcba
onmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmno
2710327103701371111111111111111111611111111111111111111116602611111111
## CORRECT ##
!t4prSOo>YO0)\_-<\BM!1T%uZu_B+fKJsZ"aMzr((rzMa"ZsJKf+B_uZu%T1!MB\<-_\)
+0OY>oOSrp4t!
Q 6~I0o] U&p}itN9:RB6'1cw+00Omf>4:zgtzM+vsv+Mztgz:4>fmO00+wc1'6BR:9Nti
+}p&U ]o0I~6 Q
BHL?[C@cc[)vjff{1*Gv7:OWGN$-:>71"6ybFE$^V^$EFby6"17>:-$NGWO:7vG*1{ffjv
+)[cc@C[?LHB
CHH+P+dkl~wZz'3r{r\C9kBXf?r]I/8/VI,AQrD0{<||<{0DrQA,IV/8/I]r?fXBk9C\r{
+r3'zZw~lkd+P+HHC
i_7m[$/Ma'Z0JD8:(:U[24Wr["EB{2?Ox6n|#7$99$7#|n6xO?2{BE"[rW42[U:(:8DJ0Z
+'aM/$[m7_i
[e&$i|YEZ~5QX-Tk?RzW(#C%> >%C#(WzR?kT-XQ5~ZEY|i$&e[
<VO]]e899Ud.k<%/'5_#w(Z7bJ?W:::x\X;]hSZ\!X/BFQ"8w8"QFB/X!\ZSh];X\x:::W
+?Jb7Z(w#_5'/%<k.dU998e]]OV<
M%;U58CJd|otnl3!!3lnto|dJC85U;%M
_Z+'yz<Z5|!9s7rEXCDVi)4xmq~6,\sm.8s`JH5B7G_6?c^JqjqJ^c?6_G7B5HJ`s8.ms\
+,6~qmx4)iVDCXEr7s9!|5Z<zy'+Z_
t;~)y7tIz9KUQ='%#DbxG'&r0-FGtgf#,n#axd0M(0t5=A"K"A=5t0(M0dxa#n,#fgtGF-
+0r&'GxbD#%'=QUK9zIt7y)~;t
xmqrepfcdojyovxeyaeeayexvoyjodcfperqmx
rqyovghhybqvbhvyyvhbvqbyhhgvoyqr
mxfrbpdzkzryxlxtmzvvzmtxlxyrzkzdpbrfxm
wsjgfphkusqlgggglqsukhpfgjsw
mopumbwennjaalwwlaajnnewbmupom
tvkolvipbelnbbnlebpivlokvt
ymnrrnmy
tworpfyheawviuvaupnnpuavuivwaehyfprowt
frfbkjwtdgqqgdtwjkbfrf
ltorcntkhpxpwcrvdjjdvrcwpxphktncrotl
rgwtikfussufkitwgr
dadad
babbab
1111121111111111112111111111111111111111112111111111111211111
acababacadacababaca
cascsac
onmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmno
bbabbbabb
61111111111111111111111111111111111111111111111111116
61111111111111111111111111111111111111111111111111116
abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfedcba
edcbabcdefedcbabcde
edcbabcdefedcbabcde
onmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmno
onmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmno
111111111111111111161111111111111111111