moo_we_all_do moo_we_all_do - 3 months ago 10
Perl Question

Iterate through all possible character combinations

In perl, I have two input strings, for this example,

ahueFFggLKy
and
HFFGLK
. I want to be able to iterate through all of the possible combinations of my input without lowercase letter groups (
a
,
h
,
u
,
e
,
g
...
ah
,
au
...
hegy
, etc) so in each iteration lowercase letters are removed and the remaining lowercase letters are uppercased:

ah:
ueFFggLKy (UEFFGGLKY)
^^

au:
h eFFggLKy (HEFFGGLKY)
^ ^

hegy:
a u FF gLKy | a u FFg LKy (AUFFGLKY)
^ ^ ^ | ^ ^ ^

auegy:
h FF gLK | h FFg LK (HFFGLK)
^ ^^ ^ ^ ^ ^^ ^ ^ -^--^-


The last option (
auegy
) is the answer, and I want to be able to iterate over letters to determine if I am able to convert
ahueFFggLKy
to
HFFGLK
without modifying any of the capital letters. This example would return
"YES"
.

If inputs like
fOoBar
and
BAR
come up, I am not successfully able to convert
fOoBar
to
BAR
because the
O
in
fOoBar
is capitalized. My program would return
"NO"
.

Can someone provide me with a perl example of how this would be done?

Answer

I think I have understood your requirement: the first string may be transformed by either deleting or upper-casing any lower-case letter, and you wish to know whether the second string can be derived from the first in this way

I suggest that you can transform the second string to a regex pattern to achieve this. If every upper-case letter in the second string must be matched by the corresponding upper or lower-case letter in the first, with any number of intervening lower-case letters, then the transformation is possible. Otherwise it is not

This program implements the idea

use strict;
use warnings 'all';
use feature 'say';

my @pairs = (
    [ qw/ ahueFFggLKy HFFGLK / ],
    [ qw/ fOoBar      BAR    / ],
);

for my $pair ( @pairs ) {
    my ($s1, $s2) = @$pair;
    printf "%s => %s -- %s\n", $s1, $s2, contains($s1, $s2) ? 'YES' : 'NO';
}

sub contains {
    my ($s1, $s2) = @_;

    my $re = join ' \p{Ll}* ', map { "(?i: $_ )" } $s2 =~ /\p{Lu}/g;
    $re = qr/ ^ \p{Ll}* $re \p{Ll}* $ /x;

    $s1 =~ $re;
}

output

ahueFFggLKy => HFFGLK -- YES
fOoBar => BAR -- NO



To read an array like @pairs from STDIN you could write something like this

my @pairs;

{
    local $/;
    my @input = split ' ', <>;
    push @pairs, [ splice @input, 0, 2 ] while @input > 1;
}
Comments