Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re: Generate all unique combinations of 1 and 0 using specified length of "0"-string and count of 1's

by Eily (Monsignor)
on Sep 18, 2020 at 07:46 UTC ( #11121895=note: print w/replies, xml ) Need Help??


in reply to Generate all unique combinations of 1 and 0 using specified length of "0"-string and count of 1's

One solution which I find pretty intuitive is to start with all zeros, and change N of thems into ones. Then the problems becomes "get all the combinations of three distinct positions", which can be achieved by using combination() function from Algorithm::Combinatorics.

use strict; use warnings; use feature 'say'; use Algorithm::Combinatorics qw(combinations); my $length = 10; my $ones = 2; my $iter = combinations([0..$length-1], $ones); while (my $positions = $iter->next) { my @data = (0,) x $length; $data[$_] = 1 for @$positions; say join "", @data; }
Now for the matter of speed, if it's really that important you'll have to benchmark, but if you're going to print each string then print is probably going to make the execution time of generating the string insignificant.

  • Comment on Re: Generate all unique combinations of 1 and 0 using specified length of "0"-string and count of 1's
  • Download Code

Replies are listed 'Best First'.
Re^2: Generate all unique combinations of 1 and 0 using specified length of "0"-string and count of 1's -- permutations
by Discipulus (Abbot) on Sep 18, 2020 at 08:35 UTC
    UPDATE this code is wrong as noticed by choroba and hippo. See below why

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
      It returns far more results than needed, as they are repeated, because for permutations, zero at position 0 is different to zero at position 1.
      map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

      This is neat code but is doing far too much work because it permutes every zero with every other zero (and also every one with every other one). eg. if you run it with 2 zeros and 2 ones you will get 4 duplicates for each answer. Increasing the numbers just makes the problem exponentially worse. Try with 9 zeros and 1 one and you'll soon see what I mean :-)


      🦛

        yes thanks choroba and hippo, my code presented above is blatantly wrong :)

        Can I add a %seen to repair my sin?

        use strict; use warnings; use feature 'say'; use Algorithm::Combinatorics qw(permutations); my $zeros = 7; my $ones = 3; my %seen; # this is really ugly # say join '', @$_ for grep{ !$seen{join('', @$_)}++ } permutations( [ + (0) x $zeros, (1) x $ones] ); # a little nicer say for grep { !$seen{$_}++ } map{join '', @$_} permutations( [(0) x $ +zeros, (1) x $ones] );

        Now the cure is worst than the disease, but runs ok

        L*

        There are no rules, there are no thumbs..
        Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

      Yup. I guess it was just too obvious for me or something ^^".

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11121895]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (3)
As of 2021-10-22 22:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (85 votes). Check out past polls.

    Notices?