#! 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, \$length ); } 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 string => no repetition \$possible = substr \$\$input, 0, \$i; # this is the minimum length candidate return \$possible if \$\$input eq substr( \$possible x ( 1 + int( \$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 consideration\n\n", \$test, \$res // \$@ ; } } } } print "Partisipants in performance tests: @{[ keys %tests ]}"; exit;