Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

And here's the proof (sorry it's so wide).

Rate bgreenlee japhy2 japhy ccn2 ccn jasper deibyz murugu clive buu jdporter aristotle limbic_region elgon browseruk aristotle2 random_walk tune
bgreenlee 1.59/s -- -44% -44% -49% -49% -50% -90% -90% -91% -97% -98% -99% -100% -100% -100% -100% -100% -100%
japhy2 2.82/s 77% -- -1% -10% -10% -11% -82% -82% -84% -94% -97% -98% -99% -99% -99% -99% -100% -100%
japhy 2.85/s 79% 1% -- -9% -9% -10% -82% -82% -84% -94% -97% -98% -99% -99% -99% -99% -100% -100%
ccn2 3.14/s 97% 11% 10% -- 0% -1% -80% -80% -82% -94% -96% -98% -99% -99% -99% -99% -100% -100%
ccn 3.14/s 97% 11% 10% 0% -- -1% -80% -80% -82% -94% -96% -98% -99% -99% -99% -99% -100% -100%
jasper 3.16/s 99% 12% 11% 1% 1% -- -80% -80% -82% -94% -96% -98% -99% -99% -99% -99% -100% -100%
deibyz 15.6/s 880% 453% 448% 396% 396% 393% -- -1% -10% -68% -82% -91% -96% -97% -97% -97% -100% -100%
murugu 15.8/s 891% 459% 454% 402% 402% 398% 1% -- -9% -68% -82% -91% -96% -96% -97% -97% -100% -100%
clive 17.3/s 984% 512% 506% 449% 449% 446% 11% 9% -- -65% -81% -90% -95% -96% -96% -97% -100% -100%
buu 49.1/s 2981% 1639% 1623% 1460% 1460% 1450% 214% 211% 184% -- -45% -72% -87% -89% -90% -91% -100% -100%
jdporter 89.1/s 5493% 3057% 3027% 2732% 2732% 2714% 471% 465% 416% 82% -- -50% -76% -80% -81% -83% -100% -100%
aristotle 178/s 11060% 6199% 6139% 5551% 5551% 5516% 1039% 1027% 929% 262% 100% -- -51% -60% -63% -67% -99% -100%
limbic_region 364/s 22756% 12800% 12679% 11474% 11474% 11401% 2232% 2207% 2008% 642% 309% 105% -- -19% -24% -32% -99% -99%
elgon 448/s 28063% 15795% 15646% 14161% 14161% 14071% 2774% 2743% 2498% 814% 404% 152% 23% -- -7% -16% -99% -99%
browseruk 481/s 30111% 16951% 16791% 15198% 15198% 15102% 2983% 2950% 2687% 881% 440% 171% 32% 7% -- -10% -99% -99%
aristotle2 532/s 33288% 18744% 18567% 16807% 16807% 16701% 3307% 3271% 2980% 984% 497% 199% 46% 19% 11% -- -98% -99%
random_walk 35318/s 2217869% 1251726% 1239954% 1123012% 1123012% 1115948% 226223% 223816% 204478% 71886% 39555% 19774% 9604% 7775% 7242% 6543% -- -31%
tune 51210/s 3215868% 1814999% 1797929% 1628368% 1628368% 1618126% 328060% 324569% 296530% 104276% 57399% 28717% 13971% 11319% 10545% 9532% 45% --

Note that I had to disqualify some entries for failing the tests.

The full benchmark I ran follows. Note that some entries required slight modifications in order to compile with strictures and run without warnings. I paid careful attention to keep the semantics intact, but if I disqualified your entry, please check my copy of your code for potential breakage.

use strict; use warnings; use Benchmark qw( cmpthese ); use Test::More qw( no_plan ); use CGI qw/ :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 ) = ( -1, 0 ); push @{ $lookup{ substr( $_[0], $_, 1 ) } }, $_ for 0 .. ( length $_[0] ) - 1; LETTER: for my $letter ( keys %lookup ) { my $last = $#{ $lookup{ $letter } }; for my $start ( 0 .. $last - 1 ) { for my $end ( reverse( $start + 1 .. $last ) ) { my $pos = $lookup{ $letter }[$start]; my $length = $lookup{ $letter }[$end] - $pos + 1; next LETTER if $length <= $record; my $palindrome = substr( $_[0], $pos, $length ); if ( $palindrome eq reverse $palindrome ) { ( $index, $record ) = ( $pos, $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!"; }, 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 = ( '27103271037013711111111111111111116111111111111111111111166026111 +11111' . '1111111111111111111111111111111111111111111611111111111111111', 'abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfe +dcba', 'ababcbabcdcbabcdedcbabcdefedcbabcdefgfedcbababcbabcdcbabcdedcbabc +defedcbabcdefgfedcba', 'abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihg +fedcbabcdefghijklmnoponmlkjihgfedcba', ); my @correct = ( '61111111111111111111111111111111111111111111111111116', 'abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfe +dcba', 'edcbabcdefedcbabcde', 'onmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmno', ); for my $user ( sort keys %contestant ) { my @result = map $contestant{ $user }->( $_ ), @{[ @input ]}; for( 0 .. $#input ) { is $result[ $_ ], $correct[ $_ ], "$user test $_"; } } 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;

Makeshifts last the longest.


In reply to Re^2: Finding longest palindrome from a string by Aristotle
in thread Finding longest palindrome from a string by BUU

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!
  • 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, 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, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            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.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others scrutinizing the Monastery: (9)
    As of 2014-12-26 04:54 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (165 votes), past polls