Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re^2: Finding longest palindrome from a string

by Limbic~Region (Chancellor)
on Aug 17, 2004 at 14:22 UTC ( #383677=note: print w/ replies, xml ) Need Help??


in reply to Re: Finding longest palindrome from a string
in thread Finding longest palindrome from a string


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; my @range = map { chr() } 32 .. 126; open (PALINDROMES, '>', 'palindromes.dat') or die "Unable to open pali +ndromes.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 ] : '') . reve +rse $string; }
Here is the actually benchmark itself:
#!/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
And here are the results:
Rate jdporter limbic_region aristotle fizbin aristotle2
jdporter 23.4/s -- -20% -28% -41% -43%
limbic_region 29.4/s 26% -- -9% -26% -29%
aristotle 32.3/s 38% 10% -- -18% -22%
fizbin 39.5/s 69% 34% 22% -- -5%
aristotle2 41.4/s 77% 41% 28% 5% --

Cheers - L~R


Comment on Re^2: Finding longest palindrome from a string
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://383677]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (6)
As of 2015-07-06 03:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (70 votes), past polls