use warnings; use strict; use Benchmark qw(cmpthese); my $str; my $len = 0; while ($len < 1000000) { my $runLen = int rand (50); $str .= chr (ord ('a') + int rand (26)) x $runLen; $len += $runLen; } my ($runlen, $start) = Index (); print "Index: Run from $start for $runlen\n"; ($runlen, $start) = Linear (); print "Linear: Run from $start for $runlen\n"; ($runlen, $start) = RegexSort (); print "RegexSort: Run from $start for $runlen\n"; cmpthese (-5, { Index => \&Index, Linear => \&Linear, RegexSort => \&RegexSort, } ); sub Index { my $sstr = substr ($str, 0, 1) . (substr ($str, 1) ^ $str); my @bestRuns; my $match = "\0"; my $bestRunLen = 1; my $scan = 0; while (-1 != ($scan = index $sstr, $match, $scan)) { my $runLen = length ((substr ($sstr, $scan) =~ /(\0+)/)[0]); if ($runLen > $bestRunLen) { # new best match @bestRuns = (); $bestRunLen = $runLen; $match = "\0" x ($bestRunLen); } push @bestRuns, $scan - 1; $scan += $bestRunLen; } return ($bestRunLen + 1, $bestRuns[0]); } sub Linear { my ($c, $maxn, $n, $maxc) = ('', 0); my $bestEnd = 0; for my $index (0..(length($str)-1)) { $_ = substr($str, $index, 1); if ($_ ne $c) { $n = 1; $c = $_; } else { $n++; if ($n > $maxn) { $maxn = $n; $maxc = $c; $bestEnd = $index } } } return ($maxn, $bestEnd - $maxn + 1); } sub RegexSort { return (length ((sort {length $b <=> length $a} $str =~ m[((.)\2+)]g)[0]), -1); }