sub findCycle searches a string to determine if it is comprised of a pattern repeated two or more times and returns the pattern length and the pattern.

If there is not a repeating pattern, the length of the string and the entire string are returned.

use strict;
use warnings;

while (<DATA>)
  my ($pattern, $cycleLen) = findCycle ($_);
  print "$_ -> $pattern ($cycleLen)\n";

sub findCycle
my $str = shift;
my $copy = $str;
my $cycleLen = 0;
my $strLen = length ($copy);

for (0..($strLen - 1))
  $copy .= substr $copy, 0, 1, '';
  $cycleLen = $_ + 1;
  ($str ^ $copy) =~ /^\0*/;
  return wantarray  ? ($cycleLen, substr $str, 0, $cycleLen)
                    : $cycleLen if $+[0] == $strLen;

return wantarray ? ($strLen, $str) : $strLen;
Replies are listed 'Best First'.
Re: Find repeated patterns in strings
by tlm (Prior) on Aug 27, 2005 at 17:54 UTC

    Actually, there's a much simpler solution (codewise):

    sub findCycle { my $str = @_ ? shift : ''; $str =~ /^(.*?)\1*$/; return wantarray ? ( length $1, $1 ) : length $1; }
    Though I suspect that, for long strings, a solution like the one you proposed but testing only cycles whose lengths are divisors of the input length would be faster. I'll do some benchmarking when I get a chance.


    the lowliest monk

      The divisors optimization occurred to me after I'd posted. I'd thought about the regex and, as you did, assumed it would be slow. Thank you for the work tlm!

      Lesson learned: it ain't obvious - benchmark!

      For the application domain this arose from findCycle_1 (divisors) is likely the best solution.

      Perl is Huffman encoded by design.


      We seem to have moved off point from the original problem. It was my original post (Search for identical strings) which sent Grandfather on his quest to optimize a search for identical substrings within a string.

      If I read this regex correctly it doesn't do what I originally asked for. That is, to find the longest set of identical substrings anywhere within a parent string.

      If I read the regex in findCycle_2 correctly it looks for a string of characters that must begin at the start of the parent string, and this substring is immediately followed by zero or more copies of itself to the end of the parent string. My original code also used a regex


      The time estimate for a search of my original data set was around 3 years! (But my data set is very large.) The time estimate was based on how long it took to search a subset of my dataset. My biggest problem appears to be with regex backtracking.

      Anyway, back to findCycle_2. Using a test string of 'ABCDEFG123456ABCDEFG' findCycle_2 returns the entire 20 character string because it found the string but no copies of itself. If I force the presence of a second copy of the substring with


      I get nothing. If I allow intervening trash with


      I get nothing. In order for the regex to find any occurrence of the longest paired substrings within a parent string it appears that the regex should be written


      And this appears to return me to the three year run.

      I should note that Grandfather created a script which ran in under a minute for my entire dataset and found over 98% of the paired substrings.


        You note that find_cycle_2seems to be broken, or at the very least doing something else.

        The lesson learned here is that benchmarks must be accompanied by tests to prove that the code actually works as intended.

        If it doesn't work, it doesn't matter how fast it is.

        Quantum Mechanics: The dreams stuff is made of

Re: Find repeated patterns in strings
by tlm (Prior) on Aug 27, 2005 at 14:31 UTC

    A simple optimization would be to replace

    for (0..($strLen-1))
    for ( 0..$strLen/2 )
    One could get fancier by testing only those cycle lengths that are either 1 or prime factors of $strLen, which could make a difference for long strings.

    Also, I think it's simpler just to test for equality of $str and $copy, obviating the xor and the regex:

    for ( 1..$strLen/2 ) { $copy .= substr $copy, 0, 1, ''; return wantarray ? ($_, substr $str, 0, $_) : $_ if $copy eq $str; }

    the lowliest monk