Matching all characters in a string except one in any position - regex

Question

How to match (preferably in perl) all strings that match the query string except one character?
Query: TLAQLLLDK
Want to match: xLAQLLLDK, TxAQLLLDK, TLxQLLLDK, etc.
Where 'x' is any capital letter '[A-Z]'.

Answer 1

Use alternation operator.
^(?:[A-Z]LAQLLLDK|T[A-Z]AQLLLDK|TL[A-Z]QLLLDK|.....)$
Likewise fill all..

Answer 2

You can do that by writing a terrible regular expression, which will be horribly slow to build and even slower to execute, or you can just don't use regexes for things like these and write a function that just compares both strings character after character, allows for one "mistake" and returns True only if there was exactly one mistake.

Answer 3

How to match (preferably in perl) all strings that match the query string except one character?
Expanding the answer of #Avinash, by generating the required regular expression dynamically at run time:
my $query = 'TLAQLLLDK';
my $re_proto = '(' . join( '|', map { (my$x=$query)=~s/^(.{$_})./$1\[A-Za-z]/; $x; } (0 .. length($query)-1) ) . ')';
my $re = qr/^$re_proto$/;
my #input = qw(xLAQLLLDK TxAQLLLDK TLxQLLLDK);
my #matches = grep { /$re/ } #input;
print "#matches\n";
(I had to include the [a-z] too, since your example input uses the x as the marker.)
If you need to do that very often, I would advise to cache the generated regular expressions.

Answer 4

Is this what you are looking for?
#!/usr/bin/perl
use strict;
my #str = ("ULAQLLLDK","TAAQLLLDK","TLCQLLLDK","TLAQLLLDK");
while(<#str>){
if (/[A-S,U-Z]LAQLLLDK|T[A-K,M-Z]AQLLLDK|TL[B-Z]QLLLDK/ ){
print "$_\n";
}
}
output:
ULAQLLLDK
TAAQLLLDK
TLCQLLLDK

Answer 5

There are only 9 x 25 = 225 such strings, so you may as well generate them all and put them in a hash for comparison
use strict;
use warnings;
use 5.010;
my %matches;
my $s = 'TLAQLLLDK';
for my $i (0 .. length($s) - 1) {
my $c = substr $s, $i, 1;
for my $cc ('A' .. 'Z') {
substr(my $ss = $s, $i, 1) = $cc;
++$matches{$ss} unless $cc eq $c;
}
}
printf "%d matches found\n", scalar keys %matches;
for ( qw/ TLAQLLLDK TLAQLXLDK / ) {
printf "\$matches{%s} = %s\n", $_, $matches{$_} // 'undef';
}
output
225 matches found
$matches{TLAQLLLDK} = undef
$matches{TLAQLXLDK} = 1