in reply to Finding repeat sequences.
Below are the results from my first pass -- verifying basic functionality -- of (my adaptions of) the 8 solutions from tye, choroba, DamianConway, tobyink, AnomalousMonk, hdb, Eily, sundialsvc4 in this thread:
C:\test>1039630-b.pl14 -SHOW=0 Looking for 'fredfre' in 'fredfrefredfr' tye found 'fredfrefred'; excluded from further consideration svc4 found 'redfrefredf'; excluded from further consideration Looking for 'fredfre' in 'fredfrefredf' Looking for 'fredfre' in 'fredfrefred' hdb found 'none found'; excluded from further consideration Looking for 'fredfre' in 'fredfrefre' Looking for 'fredfre' in 'fredfrefr' Looking for 'fredfre' in 'fredfref' Looking for 'fredfre' in 'fredfre' Looking for 'fredfre' in 'fredfrefredfrefredfr' choroba found 'fredfrefredfre'; excluded from further consideration Looking for 'fredfre' in 'fredfrefredfrefredf' Looking for 'fredfre' in 'fredfrefredfrefred' Looking for 'fredfre' in 'fredfrefredfrefre' Looking for 'fredfre' in 'fredfrefredfrefr' Looking for 'fredfre' in 'fredfrefredfref' Looking for 'fredfre' in 'fredfrefredfre' Eily found 'fredfrefred'; excluded from further consideration Partisipants in performance tests: anomalous tobyink damianc
If authors want to correct (my adaptions of) their solutions that's great, (but please don't moan at me If I screwed the pouch adapting them to subroutines :).
Here's the test harness:
#! perl -slw use strict; use 5.014; use Time::HiRes qw[ time ]; my %tests = ( tye => sub { state $re = qr[^((.*?).*?)(?=.)\1*\2$]; my $r = shift; $$r =~ $re and return $1; return; }, choroba => sub { state $re = qr[^((.*).*)\1*\2$]; my $r = shift; $$r =~ $re and return $1; return; }, damianc => sub { state $re = qr[ ^(.+?)(?{$^N}) ## $1 as $^R (?| \1+$() ## Exact rep, no $2 | \1*(.+)$ ## Partial rep as $2 ## Check its a proper prefix (??{ $^N eq substr( $^R, 0, length($^N)) ? '' : '(?! +)' }) ) ]x; my $r = shift; $$r =~ $re and return $1; return; }, tobyink => sub { my $input = shift; my $length = length $$input; for my $i ( 1 .. $length ) { my $possible = substr( $$input, 0, $i ); my $repeated = $possible x ( 1 + int( $length / $i ) ); return $possible if $$input eq substr( $repeated, 0, $leng +th ); } return; }, hdb => sub { my $input = shift; my $length = length $$input; my $i = 0; my $possible; while( 1 ) { $possible = substr $$input, 0, $i+1; # increase length by +1 $i = index $$input, $possible, $i+1; # find next occurence + of candidate return if $i < 0; # if not found return full st +ring => no repetition $possible = substr $$input, 0, $i; # this is the minimum + length candidate return $possible if $$input eq substr( $possible x ( 1 + i +nt( $length / $i ) ), 0, $length ); # success } }, Eily => sub { my $input = shift; local $_ = reverse $$input; /^(.*)(.+?\1)\2*$/ and return reverse $2; return; }, anomalous => sub { state $re = qr[ \A (.+?) \1* (.*) (?(?{ 0 != index $1, $2 }) ( +*FAIL)) \z ]xms; my $r = shift; $$r =~ $re and return $1; return }, svc4 => sub { my $search = shift; my $tail_length = 1; my $tail_step = int( length( $$search ) / 2 ); while ($tail_step > 0) { $tail_length += $tail_step while substr( $$search, 0, $tail_length + $tail_step ) eq substr( $$search, -( $tail_length + $tail_step ) +, ( $tail_length + $tail_step ) ) ; $tail_step = int( $tail_step / 2 ); } my $body_length = length( $$search ) - $tail_length; my $longest = $body_length; my $n = $body_length - 1; while( $n > 1 ) { if( ( $body_length % $n ) == 0 ) { if( substr( $$search, 0, $n ) eq substr( $$search, $n, + $n ) ) { $longest = $n; last; } } $n--; } return substr( $$search, 1, $longest ); }, ); our $SHOW //= 1; ## basic functionality my $base = 'fredfre'; for my $rep ( 2 .. 3 ) { my $full = $base x $rep; for my $x ( 1 .. length( $base ) ) { my $str = substr( $full, 0, -$x ); ## make partial print "Looking for '$base' in '$str'"; for my $test ( keys %tests ) { my $res; eval { local $SIG{ALRM} = sub { die "timeout" }; alarm 10; $res = $tests{ $test }->( \$str ) // 'none found'; alarm 0; }; $SHOW and printf "%10s -> %s\n", $test, $res // $@; if( $res ne $base and not $base eq $str or $@ eq 'timeout' ) { delete $tests{ $test }; printf "\n%10s found '%s'; excluded from further consi +deration\n\n", $test, $res // $@ ; } } } } print "Partisipants in performance tests: @{[ keys %tests ]}"; exit;
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Finding repeat sequences. (Results:Part 2. The winner)
by BrowserUk (Patriarch) on Jun 19, 2013 at 18:06 UTC | |
by hdb (Monsignor) on Jun 19, 2013 at 19:07 UTC | |
by BrowserUk (Patriarch) on Jun 19, 2013 at 19:46 UTC | |
by hdb (Monsignor) on Jun 19, 2013 at 20:03 UTC | |
|
Re^2: Finding repeat sequences. (definitions; part $n)
by tye (Sage) on Jun 20, 2013 at 00:40 UTC | |
by BrowserUk (Patriarch) on Jun 20, 2013 at 01:11 UTC |