http://qs1969.pair.com?node_id=11121910


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

This problem was visited before here and after a stupid first attempt I posted this solution, which I show again here. Note that my "permutary" routine should more accurately be called "combinatory" or something like! Posted here is code that will work for strings up to 50 or so ones and zeros but there is a version using Math::BigInt for longer strings included here.

use strict; use warnings; my ($numZeros, $numOnes) = @ARGV; die qq{Usage: $0 number_of_zeros number_of_ones\n} unless $numZeros =~ m{^\d+$} && $numOnes =~ m{^\d+$}; die qq{Maximum values of 53 to avoid precision errors\n} if $numZeros > 53 || $numOnes > 53; my $rcNextPerm = permutary($numZeros, $numOnes); print qq{$_\n} while $_ = $rcNextPerm->(); sub permutary { no warnings q{portable}; my ($numZeros, $numOnes) = @_; my $format = q{%0} . ($numZeros + $numOnes) . q{b}; my $start = oct(q{0b} . q{1} x $numOnes); my $limit = oct(q{0b} . q{1} x $numOnes . q{0} x $numZeros); return sub { return undef if $start > $limit; my $binStr = sprintf $format, $start; die qq{Error: $binStr not $numOnes ones\n} unless $numOnes == $binStr =~ tr{1}{}; my $jump = 0; if ( $binStr =~ m{(1+)$} ) { $jump = 2 ** (length($1) - 1); } elsif ( $binStr =~ m{(1+)(0+)$} ) { $jump = 2 ** (length($1) - 1) + 1; $jump += 2 ** $_ for 1 .. length($2) - 1; } else { die qq{Error: $binStr seems malformed\n}; } $start += $jump; return $binStr; }; }

I'm not sure how it would stack up in the benchmarks but I seem to recall that a regex solution from that 2007 thread was faster.

Update: Regarding GrandFather's note about the limitation of 32-bit Perl in his benchmark, I developed the code on 64-bit Perl and hit a limit at about 53 digits for either zeros or ones. The Math::BigInt version's only limit was the user's patience!

Cheers,

JohnGG