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; }; } #### use strict; use warnings; use Math::BigInt; my ($numZeros, $numOnes) = @ARGV; die qq{Usage: $0 number_of_zeros number_of_ones\n} unless $numZeros =~ m{^\d+$} && $numOnes =~ m{^\d+$}; my $rcNextPerm = permutary($numZeros, $numOnes); print qq{$_\n} while $_ = $rcNextPerm->(); sub permutary { my ($numZeros, $numOnes) = @_; my $start = Math::BigInt->new(q{0b} . q{1} x $numOnes); my $limit = Math::BigInt->new(q{0b} . q{1} x $numOnes . q{0} x $numZeros); return sub { return undef if $start > $limit; my $rcToBinary = sub { my $value = Math::BigInt->new($_[0]); my $width = $numZeros + $numOnes; my $vec = q{0} x $width; my $offset = $width; my $mask = Math::BigInt->new(1); while ( $mask <= $value ) { my $res = $value & $mask; vec($vec, -- $offset, 8) = $res ? 49 : 48; $mask->blsft(1); } return $vec; }; my $binStr = $rcToBinary->($start); my $actualOnes = $binStr =~ tr{1}{}; die qq{$binStr: Error: not $numOnes but $actualOnes ones\n} unless $numOnes == $actualOnes; my $jump; if ( $binStr =~ m{(1+)$} ) { $jump = Math::BigInt->new(2); $jump->bpow(length($1) - 1); } elsif ( $binStr =~ m{(1+)(0+)$} ) { $jump = Math::BigInt->new(2); $jump->bpow(length($1) - 1); $jump->badd(1); for my $exp ( 1 .. length($2) - 1 ) { my $incr = Math::BigInt->new(2); $incr->bpow($exp); $jump->badd($incr); } } else { die qq{$binStr: Error, seems malformed\n}; } $start->badd($jump); return $binStr; }; }