note
Limbic~Region
<br />
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:
<readmore>
<CODE>
#!/usr/bin/perl
use strict;
use warnings;
my @range = map { chr() } 32 .. 126;
open (PALINDROMES, '>', 'palindromes.dat') or die "Unable to open palindromes.dat for writing : $!";
for ( 1 .. 10 ) {
my $string;
$string .= rand() <= .3 ? gen_palindrome() : $range[ rand @range ] for 0 .. (rand 25) + 5;
print PALINDROMES $string, "\n";
}
sub gen_palindrome {
my $string;
$string .= $range[ rand @range ] for 1 .. (rand 48) + 2;
return $string . (rand() < .5 ? $range[ rand @range ] : '') . reverse $string;
}
</CODE>
</readmore>
Here is the actually benchmark itself:
<readmore>
<code>
#!/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( $longest );
}
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, $right, 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( $pal );
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 ) eq $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 - $start + 1 ) )
if substr( $string, $start, $half_length ) eq
reverse substr( $string, ( $finish - $half_length + 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<uFOnTTnOFu<OF0yy43#wly*.;WlX9]R$Gl"FcSy!t4prSOo>YO0)\_-<\BM!1T%uZu_B+fKJsZ"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?yeB0/xR/|vHMp!A$9?sc}K2Oxz48YtbTZ%(Hx3y"|pwf@$J3W1>>1W3J$@fwp|"y3xH(%ZTbtY84zxO2K}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"6ybFE$^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\C9kBXf?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)" EJtK}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(&5dAdIIT*?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?Jb7Z(w#_5'/%<k.dU998e]]OV<8x+m6!Iw%'|:MYjX8_]M+gt#v%9xdx|v/W`Z&;]Eh_mnCnm_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;XL!:p`XRC 7M?6_FIbg3c2Z}=}Z2c3gbIF_6?M7 C)hC9JS.WRIO!G1G&-SteytXZ^8B'B8^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{l0v2a1UDre;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.\)nGZCD1O1ob8~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,#fgtGF-0r&'GxbD#%'=QUK9zIt7y)~;t7Dd_w^?Mm0PxP0mM?^w_dm#
leostddtsoelirknmxrhwfuzoozufwhrjnwytnybfrrrrfbyntywnfxmqrepfcdojyovxeyaeeayexvoyjodcfperqmx
xrurqyovghhybqvbhvyyvhbvqbyhhgvoyqrrrppmycvoovcympprr
zrrpmmlygeyeqrttinhklxfccfxlkhnittrqeyegylryovaaavduooudvaaavoyttugqcihjrnmnmiywwyimnmnrjhicqgutdijvmpofmppmfopmvjimuccqieaeixkgzlpddplzgkxieaeiqccumkagegqqgegakyuplcymxfrbpdzkzryxlxtmzvvzmtxlxyrzkzdpbrfxm
kreguugerfumcvzzvcmujtfjgwsjgfphkusqlgggglqsukhpfgjswsfmujzzjumfs
dhmopumbwennjaalwwlaajnnewbmupomwbyzrryoynrrokdiidkorrnyoyrrzllssllioyllrsnmffmnsrllvsttfeymdjjxbccbxjjdmxlwaiqjkyvsgzppzgsvykjqiawbgeingpaywctdaadtcwyapgnie
mzvnytslsnqadhcsccschdaqnsxvuhrhcnrrnchrhuvxswetuutewdctvkolvipbelnbbnlebpivlokvt
cwxfymnrrnmyqiu
lamhzzcwlwoowlwczzzqeeavmfqvfsywwysfvqfmvaeequmycckptworpfyheawviuvaupnnpuavuivwaehyfprowt
frfbkjwtdgqqgdtwjkbfrfhiloxilguyqbssmbllbmssbqyucxjfjhjwkciuzjjzuickwjto
cvynpiipnyvcjybdltorcntkhpxpwcrvdjjdvrcwpxphktncrotlirekrmokbqkqaaqkqbkomrkerigxknxhekcdmuecceumdckehxneqzxkqryadbfzxvwwvxzfbdayrqkxzqe
heucfmybrgwtikfussufkitwgrktxt
dsdadadcccasdasd
ababbab
1111111121111111111112111111111111111111111112111111111111211111
ababacababacadacababacadaeadacabaz
sacascascsacascascascadvgkgjsflfjgfk
abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmnoponmlkjihgfedcba
bbabbbabbb
27103271037013711111111111111111116111111111111111111111166026111111111111111111111111111111111111111111111111111611111111111111111
61111111111111111111111111111111111111111111111111116
abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfedcba
ababcbabcdcbabcdedcbabcdefedcbabcdefgfedcbababcbabcdcbabcdedcbabcdefedcbabcdefgfedcba
edcbabcdefedcbabcde
abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmnoponmlkjihgfedcba
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
</code>
</readmore>
And here are the results:
<readmore>
<table>
<tr><td></td> <td>Rate</td> <td>jdporter</td> <td>limbic_region</td> <td>aristotle</td> <td>fizbin</td> <td>aristotle2</td></tr>
<tr><td>jdporter</td> <td>23.4/s</td> <td>--</td> <td>-20%</td> <td>-28%</td> <td>-41%</td> <td>-43%</td></tr>
<tr><td>limbic_region</td> <td>29.4/s</td> <td>26%</td> <td>--</td> <td>-9%</td> <td>-26%</td> <td>-29%</td></tr>
<tr><td>aristotle</td> <td>32.3/s</td> <td>38%</td> <td>10%</td> <td>--</td> <td>-18%</td> <td>-22%</td></tr>
<tr><td>fizbin</td> <td>39.5/s</td> <td>69%</td> <td>34%</td> <td>22%</td> <td>--</td> <td>-5%</td></tr>
<tr><td>aristotle2</td> <td>41.4/s</td> <td>77%</td> <td>41%</td> <td>28%</td> <td>5%</td> <td>--</td></tr>
</table>
</readmore>
<div class="pmsig"><div class="pmsig-180961">
<p>
Cheers - [Limbic~Region|L~R]
</p>
</div></div>
382567
383423