Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

Re: Is there a way more easy?

by martin (Friar)
on Jun 21, 2012 at 12:46 UTC ( #977630=note: print w/replies, xml ) Need Help??

in reply to Is there a way more easy?

While variations_with_repetition and mapm can reproduce the behaviour of the OP's original code, I wonder if his actual intent was precisely that.

Note that including the empty string in the list of "characters" adds shorter words to the output, while also introducing repetition and breaking lexicographic order. Each 5-letter word will appear 6 times, each 4-letter word 15 times, each 3-letter word 20 times, each 2-letter word 15 times, each single-letter word 6 times, and an empty line will also be in the output. Repeated strings will comprise 8.89 percent out of a total of 24,794,911,296 lines of output.

Let us assume that we wanted to generate all distinct non-empty strings with a given maximum length that can be build from a given alphabet.

The OP's approach with nested loops is in fact suitable for this task, with a little bit of modification.
#!/usr/bin/perl use strict; use warnings; my @alphabet = ('a'..'z', 'A'..'Z', '_'); foreach my $ch1 (@alphabet) { print $ch1, "\n"; foreach my $ch2 (@alphabet) { print $ch1, $ch2, "\n"; foreach my $ch3 (@alphabet) { print $ch1, $ch2, $ch3, "\n"; foreach my $ch4 (@alphabet) { print $ch1, $ch2, $ch3, $ch4, "\n"; foreach my $ch5 (@alphabet) { print $ch1, $ch2, $ch3, $ch4, $ch5, "\n"; foreach my $ch6 (@alphabet) { print $ch1, $ch2, $ch3, $ch4, $ch5, $ch6, "\n" +; } } } } } }

The variable @alphabet defines the characters available and their order. It does not contain an empty string. If we wanted another minimum word length we could simply remove the print statements in some of the outer loops.

The downside of this approach is that the word lengths are not controlled by simple parameters and that the code gets more and more repetitive with greater lengths.

A possible solution would be to put all those loop variables in an array and simulate how the nested loops iterate through those variables with a single loop, though at the price of a more complicated increment part, like this:

#!/usr/bin/perl use strict; use warnings; my @alphabet = ('a'..'z', 'A'..'Z', '_'); my $min_size = 1; my $max_size = 6; my @state = (); do { print @alphabet[@state], "\n" if $min_size <= @state; if (@state < $max_size) { push @state, 0; } else { for (my $i = $#state; $i >= 0; --$i) { last if ++$state[$i] < @alphabet; pop @state; } } } while (@state);

I recommend using a much smaller alphabet to test this. Note that I chose to use integer numbers in the @state array serving both as counters and indexes into the alphabet. The characters to print are then taken from an array slice.

While the second algorithm is certainly not easier to understand than the first, if a little bit shorter, it is much more flexible and still memory-efficient.

For a deeper understanding of combinatorial algorithms I warmly recommend the modern classic work by Donald E. Knuth, and its upcoming sequel.

Replies are listed 'Best First'.
Re^2: Is there a way more easy? (NestedLoops)
by tye (Sage) on Jun 24, 2012 at 18:21 UTC

    Yeah, that's one advantage of the implementation of this type of iterator that is provided in Algorithm::Loops:

    use Algorithm::Loops qw< NestedLoops >; my $listIter = NestedLoops( [ ( ['a'..'z','A'..'Z','_'] ) x 6 ], { OnlyWhen => 1 }, # { OnlyWhen => sub { 3 <= @_ } }, ); my $strIter = sub { join '', $listIter->(); }; my $str; while( $str= $strIter->() ) { print $str, $/; }

    The OnlyWhen option lets you get all lengths or just pick which lengths you are interested in.

    (I should add an option for wrapping the return value so I could build the string iterator without the extra step.)

    - tye        

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://977630]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (2)
As of 2018-05-24 23:53 GMT
Find Nodes?
    Voting Booth?