Gangabass has asked for the wisdom of the Perl Monks concerning the following question:

Hi, Monks.

I have a problem finding all permutations of a string. For example given {a|b}cd{f|g|h} i must get:

acdf
bcdf
acdg
...
bcdh

The main problem for me here is that original string may have unknown number of token {} (here we have only two but sometimes it's seven).

Here is my code (but it doesn't produce output i need):

#!/usr/bin/perl -w
use strict;
use warnings;

my $input_text;
open my $input_fh, "input.txt" or die $!;

{
    local $/;
    $input_text = <$input_fh>;
}

close $input_fh;

my @tokens;
my $number = 1;
while ( $input_text =~ m/\{([^\}]+)}/isxg ) {
    
    push @tokens, {
        
        values => [ split /\|/, $1 ],
        name => "%TOKEN_$number%",
    };
    
    $input_text =~ s/\{([^\}]+)}/%TOKEN_$number%/is;
    
    $number++;
}

foreach my $token_id ( 1 .. scalar(@tokens) ) {
    
    foreach my $value ( @{ $tokens[ $token_id - 1 ]->{values} } ) {
        
        my $output_text = $input_text;
        $output_text =~ s/%TOKEN_$token_id%/$value/is;
        
        while ( $output_text =~ m{%TOKEN_(\d+)}is ) {
            
            my $id = $1;
            $output_text =~ s/%TOKEN_$id%/$tokens[ $id - 1 ]->{values}
+->[0]/is;
        }
        
        print $output_text;
        
        #sleep 1;
    }

}

sleep 1;

[download]

Replies are listed 'Best First'.
Re: Find all string permutations
by ikegami (Patriarch) on Apr 26, 2010 at 23:15 UTC 
    use Algorithm::Loops qw( NestedLoops );

my $pat = '{a|b}cd{f|g|h}';

my @loops;
for ($pat) {
   if (/\G ( [^{]+ ) /xgc) {
      push @loops, [ $1 ];
      redo;
   }

   if (/\G \{ ([^}]*) \} /xgc) {
      push @loops, [ split /\|/, $1, -1 ];
      redo;
   }
}

NestedLoops(\@loops, sub { print(@_, "\n"); });

    [download]
    acdf
acdg
acdh
bcdf
bcdg
bcdh

    [download]

    Algorithm::Loops

[reply]
[d/l]
[select]

      Thanks! NestedLoops work like a charm.

[reply]
Re: Find all string permutations
by toolic (Bishop) on Apr 26, 2010 at 23:07 UTC
    Does glob help? 
    use strict;
use warnings;

print "$_\n" for glob '{a,b}cd{f,g,h}';

__END__
acdf
acdg
acdh
bcdf
bcdg
bcdh

    [download]

    Does output order matter?

    If this does not suit your purposes, please give a couple more examples, showing exact output.

[reply]
[d/l]
Re: Find all string permutations
by BrowserUk (Patriarch) on Apr 27, 2010 at 00:52 UTC

    For ...um ... nFor. 

    #! perl -slw
use strict;

sub nFor(&@) {
    my $code = shift;
    die "First argument must be a code ref" unless ref( $code ) eq 'CO
+DE';
    my @limits = @_;

    my @indices = ( 0 ) x @limits;

    for( my $i = $#limits; $i >= 0; ) {
        $i = $#limits;
        $code->( @indices ), ++$indices[ $i ]
            while $indices[ $i ] < $limits[ $i ];
        $i = $#limits;
        $indices[ $i ] = 0, ++$indices[ --$i ]
            while $i >= 0 and $indices[ $i ] == $limits[ $i ];
    }
}


our $TMPL //= '{a|b}cd{f|g|h}';

my @as = map {
    /\|/ ? [ split '\|', $_ ] : length() ? [$_] : ();
}  split '\{([^}]+)\}', $TMPL;


nFor {
    print join '', map $as[ $_ ][ $_[ $_ ] ], 0 .. $#_
} map scalar @$_, @as;

__END__
[ 1:50:21.76] C:\test>junk43 -TMPL="{a|b}def{g|h}j{K|l}m{n|o}p{q|r}"
adefgjKmnpq
adefgjKmnpr
adefgjKmopq
adefgjKmopr
adefgjlmnpq
adefgjlmnpr
adefgjlmopq
adefgjlmopr
adefhjKmnpq
adefhjKmnpr
adefhjKmopq
adefhjKmopr
adefhjlmnpq
adefhjlmnpr
adefhjlmopq
adefhjlmopr
bdefgjKmnpq
bdefgjKmnpr
bdefgjKmopq
bdefgjKmopr
bdefgjlmnpq
bdefgjlmnpr
bdefgjlmopq
bdefgjlmopr
bdefhjKmnpq
bdefhjKmnpr
bdefhjKmopq
bdefhjKmopr
bdefhjlmnpq
bdefhjlmnpr
bdefhjlmopq
bdefhjlmopr

    [download]
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
Re: Find all string permutations
by repellent (Priest) on Apr 27, 2010 at 05:18 UTC
    Higher-Order Perl using infinite streams with Regex.pm:
    use Regex qw(literal union concat show);

# {a|b}cd{e|f|g}h

show(
    concat(
        concat(
            union(literal("a"), literal("b")),
            literal("cd"),
        ),
        concat(
            union(literal("e"), literal("f"), literal("g")),
            literal("h"),
        ),
    ),
);

__END__
"acdeh"
"bcdeh"
"acdfh"
"acdgh"
"bcdfh"
"bcdgh"

    [download]
[reply]
[d/l]

      All that's needed now is the code to generate that from the inpu t string :)

[reply]
          All that's needed now is the code to generate that from the inpu t string :)

        ... left as an exercise for the gracious reader (-;
[reply]
A reply falls below the community's threshold of quality. You may see it by logging in.

Back to Seekers of Perl Wisdom