Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

character generator

by semio (Friar)
on Oct 24, 2004 at 17:21 UTC ( #402053=perlquestion: print w/ replies, xml ) Need Help??
semio has asked for the wisdom of the Perl Monks concerning the following question:

fellow monks,

As a personal exercise, I am interested in building a script that will generate all possible combinations of a defined set of characters. The string length is a user provided option. I put together a solution to this problem; although it works, I believe there is a better way to accomplish the desired result. As an example, here's what I've come up with.

#!perlenv -w use strict; if($#ARGV <1) { print <<EOF; usage: char-gen <charSetNum> <stringLength> charSetNum 1 = a b c charSetNum 2 = a b c 1 2 3 charSetNum 3 = a b c 1 2 3 ! @ # EOF die(); } my @charsSetOne = qw/ a b c /; my @charsSetTwo = qw/ a b c 1 2 3 /; my @charsSetThree = split // , q'abc123!@#'; my @chars; if ( $ARGV[0] == 1) { @chars = @charsSetOne; } elsif ( $ARGV[0] == 2) { @chars = @charsSetTwo; } elsif ( $ARGV[0] == 3) { @chars = @charsSetThree; } my @charsOne = @chars; my @charsTwo = @chars; my @charsThree = @chars; my $charsOne; my $charsTwo; my $charsThree; my @charSetNum = $ARGV[0]; my $stringLength = $ARGV[1]; if ( $stringLength >= 1) { for $charsOne (@charsOne) { print $charsOne . "\n"; } } if ( $stringLength >= 2) { foreach $charsOne (@charsOne) { foreach $charsTwo (@charsTwo) { print $charsOne; print $charsTwo . "\n"; } } } if ($stringLength >= 3) { foreach $charsOne (@charsOne) { foreach $charsTwo (@charsTwo) { foreach $charsThree (@charsThree) { print $charsOne; print $charsTwo; print $charsThree . "\n"; } } } }
My concern is with how I'm handling the user provided option for stringLength. In this example, I'm building nested foreach loops to handle the stringLength option. My question is: how would others approach this? As always, comments, critiques and suggestions for improvement are always welcome.

cheers, semio

Comment on character generator
Download Code
Re: character generator
by gaal (Parson) on Oct 24, 2004 at 17:25 UTC
Re: character generator
by ikegami (Pope) on Oct 24, 2004 at 17:37 UTC
    NextPermute of Algorithm::Loops will do the trick, and it even has code that considers duplicate letters to be the same so you won't get "tool" twice while asking for permutations of "loot" (for example).
Re: character generator
by pg (Canon) on Oct 24, 2004 at 18:23 UTC

    As an exercise, this is actually a good candidate for recursion (we have a recursion fever here these days): (I simplified the question a little bit, and assume we only want full length strings, strings that are formed by all characters in the set, so we can focus on recursion)

    use Data::Dumper; use strict; use warnings; my @set = ('1', '2', '3'); my @strings = generate(@set); print Dumper(\@strings); sub generate { my @set = @_; my @strings; if ($#set == 0) { return ($set[0]); } else { for (0 .. $#set) { my @temp = @set; my $t = splice(@temp, $_, 1); push @strings, "$t$_" foreach (generate(@temp)); } return @strings; } }

      Actually can be easily modified to generate strings with a specified length (not just the full length):

      use Data::Dumper; use strict; use warnings; my @set = ('1', '2', '3', '4'); my $len = 3; #test shows that it is safe to specify len greater than s +et size, or equal to set size, or less than my @strings = generate($len, @set); print Dumper(\@strings); sub generate { my $len = shift; my @set = @_; my @strings; if ($#set == 0) { return ($set[0]); } else { if ($len == 1) { push @strings, "$_" foreach (@set); } else { for (0 .. $#set) { my @temp = @set; my $t = splice(@temp, $_, 1); push @strings, "$t$_" foreach (generate($len - 1, @temp)); } } return @strings; } }
Re: character generator
by TedPride (Priest) on Oct 25, 2004 at 01:15 UTC
    use strict; print "Enter characters to permutate : "; $_ = <STDIN>; s/\s+//g; split(//); my ($last, $chars); foreach (sort @_) { if ($_ ne $last) { $chars .= $_; $last = $_; } } for ($_ = length($chars); $_; $_--) { permutate($_, $chars); } sub permutate { my ($depth, $chars, $pre) = @_; if ($depth == 1) { print $pre.substr($chars,$_,1)."\n" for (0..(length($chars)-1) +); } else { for (0..(length($chars)-$depth)) { permutate($depth-1, substr($chars,$_+1), $pre.substr($char +s,$_,1)); } } }
    This takes input from STDIN rather than ARGV, but does print all the permutations correctly. It's a recursive solution using strings to track permutations.
Re: character generator
by tmoertel (Chaplain) on Oct 25, 2004 at 20:00 UTC
    Here's one way to compute the combinations that can be created by drawing a single element from each of a list of given sets:
    #!/usr/bin/perl -l use warnings; use strict; use List::Util qw( reduce ); sub combinations { no warnings qw( once ); reduce { outer_r($a,$b) } [[]], reverse @_; } sub outer_r { my ($ys, $xs) = @_; my @product; foreach my $x (@$xs) { foreach my $y (@$ys) { push @product, [$x, @$y]; } } return \@product; }
    The combinations function takes a list of sets (each represented as an arrayref) and returns the combinations that can be created from them:
    use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; print Dumper( combinations( [1..3], ["a","b"] ) ), "\n"; # [[1,'a'],[1,'b'],[2,'a'],[2,'b'],[3,'a'],[3,'b']]
    With this function, we can turn to your question of how best to represent your character sets. I would just use strings to keep things simple. A helper function will convert strings into the form needed by combinations and then convert the results back into strings:
    sub charset_combinations { my @charsets = map [split//], @_; map join("", @$_), @{ combinations( @charsets ) }; }
    Let's use our new helper to find all of the 3-character combinations that can be made from the charset "abc":
    my @abcees3 = charset_combinations( ("abc") x 3 ); print "@abcees3\n"; # aaa aab aac aba abb abc aca acb acc\ # baa bab bac bba bbb bbc bca bcb bcc\ # caa cab cac cba cbb cbc cca ccb ccc
    We can even draw successive characters from different character sets:
    my @charsets = qw( abc 123 !@$ ); foreach my $string_length (0 .. @charsets) { my @genstrings = charset_combinations( @charsets[0..$string_length-1] ); print "$string_length: @genstrings\n"; } # 0: # 1: a b c # 2: a1 a2 a3 b1 b2 b3 c1 c2 c3 # 3: a1! a1@ a1$ a2! a2@ a2$ a3! a3@ a3$\ # b1! b1@ b1$ b2! b2@ b2$ b3! b3@ b3$\ # c1! c1@ c1$ c2! c2@ c2$ c3! c3@ c3$
    I hope this gives you some helpful ideas.

    Cheers,
    Tom

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://402053]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (9)
As of 2014-09-01 09:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (299 votes), past polls