Regular expression to match exactly and only n times

user_14743439 0
Viewed 390

If I have the lines:

  1. 'aslkdfjcacttlaksdjcacttlaksjdfcacttlskjdf'
  2. 'asfdcacttaskdfjcacttklasdjf'
  3. 'cksjdfcacttlkasdjf'

I want to match them by the number of times a repeating subunit (cactt) occurs. In other words, if I ask for n repeats, I want matches that contain n and ONLY n instances of the pattern.

My initial attempt was implemented in perl and looks like this:

    sub MATCHER {
        print "matches with $_ CACTT's\n";
        my $pattern = "^(.*?CACTT.+?){$_}(?!.*?CACTT).*\$";
        my @grep_matches = grep(/$pattern/, @matching);
        print "$_\n" for @grep_matches;
        my @copy = @grep_matches;
        my $squashed = @copy;
        print "number of rows total: $squashed\n";
    }

    for (2...6) {
        MATCHER($_);
    }

Notes:

@matching contains the strings from 1, 2, and 3 in an array. the for loop is set from integers 2-6 because I have a separate regex that works to forbid duplicate occurrences of the pattern.

This loop ALMOST works except that for n=2, matches containing 3 occurrences of the "cactt" pattern are returned. In fact, for any string containing n+1 matches (where n>=2), lines with n+1 occurrences are also returned by the match. I though the negative lookahead could prevent this behavior in perl. If anyone could give me thoughts, I would be appreciative.

Also, I have thought of getting a count per line and separating them by count; I dislike the approach because it requires two steps when one should accomplish what I want.

I would be okay with a:

    foreach (@matches) { $_ =~ /$pattern/; push(@selected_by_n, $1);}

The regex seems like it should be similar, but for whatever reason in practice the results differ dramatically.

Thanks in advance!

perl regex
3 Answers

Your code is sort of strange. This regex

my $pattern = "^(.*?CACTT.+?){$_}(?!.*?CACTT).*\$";

..tries to match first beginning of string ^, then a minimal match of any character .*?, followed by your sequence CACTT, followed by a minimal match (but slightly different from .*?) .+?. And you want to match these $_ times. You assume $_ will be correct when calling the sub (this is bad). Then you have a look-ahead assumption that wants to make sure that there is no minimal match of any char .*? followed by your sequence, followed by any char of any length followed by end of line $.

First off, this is always redundant: ^.*. Beginning of line anchor followed by any character any number of times. This actually makes the anchor useless. Same goes for .*$. Why? Because any match that will occur, will occur anyway at the first possible time. And .*$ matches exactly the same thing that the empty string does: Anything.

For example: the regex /^.*?foo.*?$/ matches exactly the same thing as /foo/. (Excluding cases of multiline matching with strings that contain newlines).

In your case, if you want to count the occurrences of a string inside a string, you can just match them like this:

my $count = () = $str =~ /CACTT/gi;

This code:

my @copy = @grep_matches;
my $squashed = @copy;

Is completely redundant. You can just do my $squashed = @grep_matches. It makes little to no sense to first copy the array.

This code:

MATCHER($_);

Does the same as this: MATCHER("foo") or MATCHER(3.1415926536). You are not using the subroutine argument, you are ignoring it, and relying on the fact that $_ is global and visible inside the sub. What you want to do is

sub MATCHER {
    my $number = shift;   # shift argument from @_

Now you have encapsulated the code and all is well.

What you want to do in your case, I assume, is to count the occurrences of the substring inside your strings, then report them. I would do something like this

use strict;
use warnings;
use Data::Dumper;

my %data;
while (<DATA>) {
    chomp;
    my $count = () = /cactt/gi;      # count number of matches
    push @{ $data{$count} }, $_;     # store count and original
}

print Dumper \%data;

__DATA__
aslkdfjcacttlaksdjcacttlaksjdfcacttlskjdf
asfdcacttaskdfjcacttklasdjf
cksjdfcacttlkasdjf

This will print

$VAR1 = {
          '2' => [
                   'asfdcacttaskdfjcacttklasdjf'
                 ],
          '3' => [
                   'aslkdfjcacttlaksdjcacttlaksjdfcacttlskjdf'
                 ],
          '1' => [
                   'cksjdfcacttlkasdjf'
                 ]
        };

This is just to demonstrate how to create the data structure. You can now access the strings in the order of matches. For example:

for (@$data{3}) {    # print strings with 3 matches
    print;
}
user_7254180

Would you just do something like this:

use warnings;
use strict;

my $n=2;
my $match_line_cnt=0;
my $line_cnt=0;

while (<DATA>) {
    my $m_cnt = () = /cactt/g;
    if ($m_cnt>=$n){
        print;
        $match_line_cnt++;
    }
    $line_cnt++;
}
print "total lines: $line_cnt\n";
print "matched lines: $match_line_cnt\n";
print "squashed: ",$line_cnt-$match_line_cnt;

    
__DATA__    
aslkdfjcacttlaksdjcacttlaksjdfcacttlskjdf
asfdcacttaskdfjcacttklasdjf
cksjdfcacttlkasdjf

prints:

aslkdfjcacttlaksdjcacttlaksjdfcacttlskjdf
asfdcacttaskdfjcacttklasdjf
total lines: 3
matched lines: 2
squashed: 1
user_2986070

I think you're unintentionally asking two seperate questions.

If you want to directly capture the number of times a pattern matches in a string, this one liner is all you need.

$string = 'aslkdfjcacttlaksdjcacttlaksjdfcacttlskjdf';
$pattern = qr/cactt/;
print $count = () = $string =~ m/$pattern/g;

-> 3

That last line is as if you had written $count = @junk = $string =~ m/$pattern/g; but without needing an intermediate array variable. () = is the null list assignment and it throws away whatever is assigned to it just like scalar undef = throws away its right hand side. But, the null list assignment still returns the number of things thrown away when its left hand side is in scalar context. It returns an empty list in list context.

If you want to match strings that only contain some number of pattern matches, then you want to stop matching once too many are found. If the string is large (like a document) then you would waste a lot of time counting past n.

Try this.

sub matcher {
  my ($string, $pattern, $n) = @_;
  my $c = 0;
  while ($string =~ m/$pattern/g) {
    $c++;
    return if $c > $n;
  }
  return $c == $n ? 1 : ();
}

Now there is one more option but if you call it over and over again it gets inefficient. You can build a custom regex that matches only n times on the fly. If you only build this once however, it's just fine and speedy. I think this is what you originally had in mind.

$regex = qr/^(?:(?:(?!$pattern).)*$pattern){$n}(?:(?!$pattern).)*$/;

I'll leave the rest of that one to you. Check for n > 1 etc. The key is understanding how to use lookahead. You have to match all the NOT THINGS before you try to match THING.

https://perldoc.perl.org/perlre

user_114131060
Related