Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Find all string permutations

by Gangabass (Vicar)
on Apr 26, 2010 at 22:57 UTC ( [id://836989]=perlquestion: print w/replies, xml ) Need Help??

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;

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"); });
    acdf acdg acdh bcdf bcdg bcdh

    Algorithm::Loops

      Thanks! NestedLoops work like a charm.

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

    Does output order matter?

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

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

    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.
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"

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

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

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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://836989]
Approved by toolic
Front-paged by toolic
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (2)
As of 2024-04-20 06:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found