Just solved that way:
my @groups = (); my $pred = -1; my $j = 0; while ($string =~ m/$regex/g){ $pred == $-[0] or $j++; $groups[$j] += $+[0] - $-[0]; $pred = $+[0]; }
And reduced regex to:
qr{ # start of full pattern \( # match an opening parenthesis (?0)* # recurse to capture full pattern \) # match a closing parenthesis # end of full pattern }x;


UPDATE: seems that using recursive regex is dangerous, because in rare random "unlucky cases" it takes very much time, although in often "lucky cases" it takes little amount of time. I found seemingly better and faster (or say more stable) way - just glue long regex and use+modify through iterations against the target string. Code:
#use strict; use warnings; use Time::HiRes; $|++; srand; my @lines = <>; my $n = 50000; my $long = ''; $long .= qw{( )}[ int(rand() * 2) ] for 1 .. $n; push @lines, $long; my @lines2 = @lines; my $start = Time::HiRes::time(); my $depth = 10; # some depth parameter my $pre_regex2 = '(?:\((?:\d+,)*(?:\)|' x $depth . '(?!)' . '\)))+' x $depth; # if $depth == 1 then looks: '(?:\((?:\d+,)*(?:\)|x\)))+'; # (?: # \( # (?:\d+,)* (?: # \) # | # (?!)\) # ) # )+ my $regex2 = qr/$pre_regex2/; my $regex3 = qr/(?:\d+,){2,}/; for my $string (@lines2){ while ( $string =~ s/$regex2/ $a=$&, $b=()=$a=~m{[)(]}g, $a=~s{\d+,}{$b+=$&,''}eg, "$b," /eg or $string =~ s/$regex3/ $a=$&, $b=0, $a=~s{\d+,}{$b+=$&,''}eg, "$b," /eg ) {} my @groups = $string =~ m/\d+/g; my $max=0; for my $group (@groups){ $max < $group and $max = $group } my $occ = 0; for my $group (@groups){ $occ += $max == $group } $max or $occ=1; print "$max $occ\n"; } print Time::HiRes::time() - $start, $/; $start = Time::HiRes::time(); my $regex = qr{ \( # match an opening parenthesis (?0)* # recurse to capture full pattern \) # match a closing parenthesis }x; for my $string (@lines) { my $max = 0; my $occ = 1; my @groups = (); my $pred = -1; my $i = 0; while ($string =~ m/$regex/g){ $pred == $-[0] or $i++; $groups[$i] += $+[0] - $-[0]; $pred = $+[0]; } if (@groups) { @groups = sort { $a <=> $b } @groups; $max = $groups[-1]; for my $i (reverse 0 .. $#groups - 1) { if ( $groups[$i] == $groups[-1]) { ++$occ; } else { last; } } } print "$max $occ\n"; } print Time::HiRes::time() - $start, $/;
( http://ideone.com/K12225 )
Usually first block takes ~0,5 sec, when second block (recursive regex) takes from 0.01 sec to more than 5 sec.

In reply to Re^4: how to speed up that dynamic regex? by rsFalse
in thread how to speed up that dynamic regex? by rsFalse

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.