Getting all possible string combinations with Perl

Question

Given a string such as "rogerdavis", it should convert it to "rogerd @vis" or "rogerdav! S" or "rogerdavi $" or "rogerd @v! $" And all the possible combinations and add it to the file. So basically you need to convert 'a' to '@', 's' to '$' and 'i' to '!' and use all possible combinations. This should be done in Perl.

pseudo code

• Create new file
• Calculate the number of occurrences a, A, s, S, i, i (or we can accept the keyword only in small or in caps to simplify the switch case)
• Calculate the total number of opportunities that we can get using the combination formula. For the total number of possibilities, we perform the task under the replacement of the symbol a ->@ , s->$ , i-> I
• add a unique record to the file

This is what occurred to me. Please help me because I know that there should be a simple and easy way to do this:

• Accept keyword in keyword[ ] array
• Calculate array length in length_of_keyword
• The array of crawl keyword[ ] from left to right count = 0; for (i = 0; i}

• Using count to calculate the total number of possibilities

   total_poss =0; r= 1; new_count = count for (i = count; i > 0; i--) { // fact( ) will calculate factorial total_poss += fact(new_count)/(fact(r)*fact(new_count - r)) r++; } for (k=0; k<total_poss; total_poss++) copy array keyword[ ] in temporary array temp[ ]; for (i=0; i< new_count; i++) { for (j = 0; j< lenght_of_keyword; j++) { if (temp[i] is equal to 'a' || 'A' || 's' || 'S' || 'i' || 'I' ) { switch (temp[j]) case i: tempt[i] = ! ; if ( modified array is equal to an entry in file) continue; else save in file; break; case I: (same as above or we can have function for above code) . .// similarly for all cases . } } } 

Answer 1

I wanted to give List::Gen whirlwind. This problem was a great excuse!

---

 use strict; use warnings; use List::Gen; my %symbol = ( a => '@', A => '@', i => '!', I => '!', s => '$', S => '$', ); # Symbol table my $string = 'rogerdavis'; my @chunks = split /(?<=[ais])|(?=[ais])/i, $string; # Turn into arrayrefs for cartesian function @chunks = map { $_ =~ /^[ais]$/i ? [ $_, $symbol{$_} ] : [ $_ ] } @chunks; my $cartesian = cartesian { join '', @_ } @chunks; # returns a generator say for @$cartesian; # or 'say while < $cartesian >' 

---

Output

 rogerdavis rogerdavi$ rogerdav!s rogerdav!$ rogerd@vis rogerd@vi $ rogerd@v !s rogerd@v !$ 

Answer 2

Use support for multiple patterns (3) with glob (3), replacing a with {a, @}, s {s, $} and I with {i ,!} as follows:

 my $str = 'rogerdavis'; my $glob = $str; # set up replacement character map my %replacements = (a => '@', s => '$', i => '!'); # add uppercase mappings $replacements{uc $_} = $replacements{$_} for keys %replacements; # replace 'character' with '{character,replacement}' $glob =~ s/([asi])/{$1,$replacements{$1}}/ig; my @list = glob($glob); print join "\n", @list; print "\n"; my $count = scalar(@list); 

If the replacement character is the glob (7) metacharacter, then it must be escaped ( 3 => '\}', e => '\[' , for example).

Update: you can replace [asi] with the results of doing something like Data :: Munge list2re, fe:

 my $re = Data::Munge::list2re(keys %replacements); $glob =~ s/($re)/{$1,$replacements{$1}}/ig; 

Answer 3

The implementation of fairly bare bones:

 sub convert { my $keyword = shift @_; my $map = @_ ? $_[ 0 ] : \%MAP; my @parts = do { my $regex = do { my $letters = join('', keys %$map); qr/([$letters])/i; }; split($regex, $keyword, -1); }; my $n_slots = ( -1 + scalar @parts )/2; my $n_variants = 2 ** $n_slots; my @variants; my $i = 0; # use $i = 1 instead to keep the original $keyword # out of the list of variants while ( $i < $n_variants ) { my @template = @parts; my $j = 1; my $k = $i; for ( 1 .. $n_slots ) { $template[ $j ] = $map->{ lc $parts[ $j ] } if $k & 1; $j += 2; $k >>= 1; } push @variants, join( '', @template ); $i++; } return \@variants; } sub main { my $keyword = shift @_; my $fh = @_ ? ( open( $_[ 0 ], 'a' ) or die $! ) : \*STDOUT; print $fh "$_\n" for @{ convert( $keyword ) }; } main( $ARGV[ 0 ] ); 

Run Example:

 % perl 6995383.pl rogerDaViS rogerDaViS rogerD@ViS rogerDaV!S rogerD@V !S rogerDaVi$ rogerD@Vi $ rogerDaV!$ rogerD@V !$ 

Forgive the lack of comments and the lack of error handling (hurried over time), but the main idea is that if there are n slots that can be replaced, and if we assume that there is only one possible alternative for each slot, then there are 2 ^ n options (including the original keyword). The bits in the (binary representation) of the $i index are used to track which positions to replace at each iteration of the outer loop. Therefore, iterating with $i == 0 leaves the keyword unchanged. (Therefore, if you do not need this “option”, just shift it from the returned array.)

This is just the first crack. In addition to comments and error handling, I'm sure that with a little thought, this implementation can be greatly improved / tightened.

NTN ...