Match only if all characters in a set are present

Viewed 420

Character classes like /[abcde]/ are great when you want to match any character in the class, but I want to enforce that all characters in the set should be present, regardless of the order they appear in.

So if my set comprises of abcde the regex should:

  • successfully match strings like "ascribed", "cheeseboard", and "eradicable"
  • fail to match "vibrance", "yeti" and "wishful"

I do have a working solution that involves use of multiple lookahead assertions:

/(?=.*a)(?=.*b)(?=.*c)(?=.*d)(?=.*e)/

but wonder if there are alternatives to this.

It doesn't look too bad if you're coding this by hand.

However, if you want to parametrize it to an arbitrary set of characters it requires you to write a sub that generates a suitable regex. I guess that the generalizability of my current approach is what I'm not so keen on.

5 Answers

Readability matters.

/a/ && /b/ && /c/ && /d/ && /e/

This is possibly a little bit slower than some of the solutions below. But speed isn't everything, especially if both alternatives are quite fast.

Readability and maintainability are usually far more important, and this is clearly far more readable and maintainable than the original.


Still, I'll continue with other alternatives.

First of all, we can micro-optimize what you have:

/^(?=.*a)(?=.*b)(?=.*c)(?=.*d).*e/s

This eliminates a serious amount of backtracking when the pattern doesn't match, and it probably even speeds up positive matches by not checking for line feeds.

Even faster,

/^(?=.*?a)(?=.*?b)(?=.*?c)(?=.*?d).*?e/s

For strings to match literally, though, using index instead of the regex engine should be faster.

my @strs = qw( a b c d e );
my $str = $_;
@strs == grep { index($str, $_) >= 0 } @strs

use List::Util qw( all );
my @strs = qw( a b c d e );
my $str = $_;
all { index($str, $_) >= 0 } @strs

An approach that works well for a dynamic list of characters:

my @chars = qw( a b c d e );
my %counts;
++$counts{$_} for unpack '(a)*', $_;
@chars == grep { $counts{$_} } @chars

use List::Util qw( all );
my @chars = qw( a b c d e );
my %counts;
++$counts{$_} for unpack '(a)*', $_;
all { $counts{$_} } @chars

The downside is that this doesn't short circuit. It still needs to process the entire string even if it starts with abcde.


If you have a dynamic list of patterns, you can still use some of the earlier approaches.

# /^(?=.*?a)(?=.*?b)(?=.*?c)(?=.*?d).*?e/s
my $pat = join "", map { "(?=.*?$_)" } @pats;
my $re = qr/^$pat/s;
/$re/

# /a/ && /b/ && /c/ && /d/ && /e/
my $str = $_;
@pats == grep { $str =~ /$_/ } @pats

# /a/ && /b/ && /c/ && /d/ && /e/
use List::Util qw( all );
my $str = $_;
all { $str =~ /$_/ } @pats

I would go with multiple patterns and match for all of them, as that is much easier to read. Most of the time in my opinion the simplest way is the best.

Stick the patterns in an array and use all from List::Util.

use feature 'say';
use List::Util 'all';

my @patterns = (qr/a/, qr/b/, qr/c/, qr/d/, qr/e/);

foreach my $word (qw(ascribed cheeseboard eradicable vibrance yeti wishful)) {
    say $word if all { $word =~ $_ } @patterns;
}

The following script accepts one word per line from standard input and prints the ones which have all the characters present in the first argument. Save script in file named has_all_chr.pl and run like cat words | perl has_all_chr.pl abcde. You can easily adapt it for your requirement.

use strict;
use warnings;
use List::Util;

my @c = List::Util::uniq( split "", shift ); 
#unique characters to look for in words

my @in = <>;
chomp @in;

for my $word (@in) {

    next if length $word < @c;
    #reject if word is too short to contain all characters

    print "$word\n" if List::Util::all { -1 != index $word, $_ } @c; 
    #all chrs must be present
}

If the file words has:

ascribed
cheeseboard
eradicable
vibrance
yeti
wishful

then the output is

ascribed
cheeseboard
eradicable

you can capture all the matches as a string then match that against your key

perl -le '$x = "cheeseboard"; $r = join "", sort ($x =~ /[abcde]/g); print $r =~ /a+b+c+d+e+/'

You could bind the expression to the very start of the string and use the principle of contrast:

^(?=[^a]*a)(?=[^b]*b)(?=[^c]*c)(?=[^d]*d)(?=[^e]*e).+

See a demo on regex101.com.

Related