There's more than one way to do things PerlMonks

Find repeated patterns in strings

by GrandFather (Sage)
 on Aug 27, 2005 at 04:48 UTC Need Help??
 Description: 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>)
{
chomp;
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;
}
__DATA__
TTTTT
ATATAT
ATTATTATT
123412341234
123456
```
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.

Update:

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.

Gentlemen,

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

/(.+).*\1/

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

/^(.*?)\1\$/

I get nothing. If I allow intervening trash with

/^(.*?).*\1\$/

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

/(.+).*\1/

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.

Mike

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.

-QM
--
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))
with
```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

Create A New User
Node Status?
node history
Node Type: snippet [id://487095]
help
Chatterbox?
 [marto]: yikes [marto]: and this is a bank you say? [hippo]: Yary: There are a few useful pointers in I need perl coding standards [hippo]: ... and a boatload of good stuff in On Coding Standards and Code Reviews

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (10)
As of 2018-01-23 16:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
How did you see in the new year?

Results (250 votes). Check out past polls.

Notices?