in reply to Re: how to speed up that dynamic regex?
in thread how to speed up that dynamic regex?

my $regex =
 qr{
     (                       # start of capture group 1
         ...
                 (?1)        # recurse to capture group 1
         ...
     )                       # end of capture group 1
 }x;

[download]

A neat feature of the  (?PARNO) extended pattern (available with Perl versions 5.10+) is that the numbering of capture groups can be made relative instead of absolute. This shines brightest when defining  qr// regex objects, which are designed to be interpolated into other  qr// m// s/// expressions. The logic of group recursion can be encapsulated and made independent of whatever other expressions go into the final regex.

In Athanasius's code above, if even one more capturing group sneaks into the  m// ahead of  $regex in the extraction expression
    my @groups = $string =~ m/$regex/g;
as in
    my @groups = $string =~ m/(x?)$regex/g;
capture group numbering is thrown off and its function is destroyed. If the absolute  (?1) group recursion in
    my $regex = qr{ (... (?1) ...) }x;
is made relative with  (?-1) then any number of extra preceding capture groups will make no difference to its function:
    my @groups = $string =~ m/(x?)(x?)(x?)$regex/g;

Replies are listed 'Best First'.
Re^3: how to speed up that dynamic regex?
by rsFalse (Chaplain) on Nov 07, 2014 at 10:44 UTC
    It seems that using (?PARNO) in my example speeds up coping against long random line of parentheses at least 10 times on average.
    But still there are some frequent random data, that regex works slow. I changed the length of random line to 50000, and then sometimes regex cope in 0.1 sec, and sometimes it takes >5 sec.
    I only changed regex a little bit: 
    my $regex =
qr{
                           # start of full pattern
        \(                  # match an opening parenthesis
            (?:
                0        # everytime false, because of such DATA
                |           # OR
                (?0)        # recurse to capture full pattern
            )*
        \)                  # match a closing parenthesis
                           # end of  full pattern
}x;

    [download]
    One more question: how to find consecutive balanced parentheses (and their max length with frequency of them)? I used "+" quantifier in: m/$regex+/g (/$m+/g). Now if I use this quantifier, program works with really bad asymptotics, but if I use possesive m/$regex++/g, it run faster but still slow. Why?
[reply]
[d/l]
      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];
        }

      [download]
      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;

      [download]


      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, $/;

      [download]
      ( 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.
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom