Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Is there a way more easy?

by spadacciniweb (Deacon)
on Jun 20, 2012 at 14:02 UTC ( #977353=perlquestion: print w/ replies, xml ) Need Help??
spadacciniweb has asked for the wisdom of the Perl Monks concerning the following question:

Is there a way more easy to write this code?

#!/usr/bin/perl use strict; use warnings; foreach my $char1 ('', 'a'..'z', 'A'..'Z', '_' ) { foreach my $char2 ('', 'a'..'z', 'A'..'Z', '_' ) { foreach my $char3 ('', 'a'..'z', 'A'..'Z', '_' ) { foreach my $char4 ('', 'a'..'z', 'A'..'Z', '_' ) { foreach my $char5 ('', 'a'..'z', 'A'..'Z', '_' ) { foreach my $char6 ('', 'a'..'z', 'A'..'Z', '_' ) { my $plain = $char1 . $char2 . $char3 . $char4 +. $char5. $char6; print $plain,"\n"; } } } } } }

I have tried Regexp::Genex but it seem not for me because the output are only a few $plain.

#!/usr/bin/perl use warnings; use strict; use Regexp::Genex qw(:all); my $regex = '\w{1,6}'; for my $plain ( strings($regex) ) { print $plain, "\n"; }

(($_="Mzz ojjdloobnf jt uvy5502383")=~y~b-zg2-5c96-81~a-z0-9~s)=~s~~~s; print

Comment on Is there a way more easy?
Select or Download Code
Re: Is there a way more easy?
by Ratazong (Prior) on Jun 20, 2012 at 14:11 UTC

    Algorithm::Combinatorics might help you ... the reference-section of the documentation gives you some background-reading. You may also check the other CPAN-modules containing the name combinatorics.

    HTH, Rata

      I've solved using this code:

      #!/usr/bin/perl use strict; use warnings; use Algorithm::Combinatorics qw(variations_with_repetition); my @data = ('', 'a'..'z', 'A'..'Z','_'); my $iter = variations_with_repetition(\@data, 6); while (my $p = $iter->next) { my $plain = join '', values $p; print $plain,'.'; }
      Thank you!

      (($_="Mzz ojjdloobnf jt uvy5502383")=~y~b-zg2-5c96-81~a-z0-9~s)=~s~~~s; print
Re: Is there a way more easy?
by RichardK (Priest) on Jun 20, 2012 at 14:49 UTC

    You could use glob, however it will produce a large list. :)

    For example, something like this :-

    my $vals = join(',',(0..9,'a'..'z','A'..'Z','_')); say $_ for glob ("{$vals}{$vals}{$vals}");

      No, too many combinations


      (($_="Mzz ojjdloobnf jt uvy5502383")=~y~b-zg2-5c96-81~a-z0-9~s)=~s~~~s; print
Re: Is there a way more easy?
by tobyink (Abbot) on Jun 20, 2012 at 14:51 UTC

    This does the trick...

    use 5.010; use List::MapMulti; my $letters = ['', 'a'..'z', 'A'..'Z', '_']; mapm { say join q() => @_ } ($letters) x 6;
    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'

      Good, I didn't known List::MapMulti


      (($_="Mzz ojjdloobnf jt uvy5502383")=~y~b-zg2-5c96-81~a-z0-9~s)=~s~~~s; print
Re: Is there a way more easy?
by pvaldes (Chaplain) on Jun 20, 2012 at 16:31 UTC

    sligthly different, but same idea. Only advantage here to tip a little less

    my @list = ('',a..z,A..Z,'_'); for my $elem1 (@list){ for my $elem2 (@list){ for my $elem3 (@list){ for my $elem4 (@list){ for my $elem5 (@list){ for my $elem6 (@list){ print $elem1,$elem2,$elem3,$elem4,$elem5,$elem6,"\n" }}}}}}

      :-)


      (($_="Mzz ojjdloobnf jt uvy5502383")=~y~b-zg2-5c96-81~a-z0-9~s)=~s~~~s; print
Re: Is there a way more easy?
by martin (Pilgrim) on Jun 21, 2012 at 12:46 UTC

    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.

      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        

Re: Is there a way more easy?
by klekker (Pilgrim) on Jun 21, 2012 at 15:27 UTC
    Hi,
    using some functional programming to create an iterator you can end up with something like this:
    use Modern::Perl; #my $alphabet = ['a'..'z', 'A'..'Z']; #my $word_length = 6; my $alphabet = ['a'..'b', '_']; my $word_length = 3; sub create_dictionary { my ($alphabet, $word_length) = @_; my @odometer = (0) x $word_length; my $len_alpha = @$alphabet; my $exhausted = 0; return sub { my $str = undef; if (!$exhausted) { $str = join('', map { $alphabet->[$_] } @odometer); my $add = 1; @odometer = map { $_+=$add; $add = $_ >= $len_alpha ? 1:0 +; $_% $len_alpha } @odometer; $exhausted = $add; # last carry == 1 => exhausted! } return $str; }; } my $dict = create_dictionary($alphabet, $word_length); while (my $word = $dict->()) { say $word; }

    I got the odometer idea (if I remember correctly) from "higher order perl" http://hop.perl.plover.com/.

    k

      List::MapMulti uses an odometer iterator internally.

      perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
Re: Is there a way more easy?
by Skeeve (Vicar) on Jun 24, 2012 at 19:33 UTC

    Some good old recursive programming:

    my @a=('', 'a'..'z', 'A'..'Z', '_'); v("",3,\@a); sub v { my ($p,$n,$a)=@_; if ($n) { --$n; v($p.$_,$n,$a) foreach (@$a); } else { print $p,"\n" } }

    s$$([},&%#}/&/]+}%&{})*;#$&&s&&$^X.($'^"%]=\&(|?*{%
    +.+=%;.#_}\&"^"-+%*).}%:##%}={~=~:.")&e&&s""`$''`"e

Log In?
Username:
Password:

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

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

    My favorite cookbook is:










    Results (15 votes), past polls