This worked for small values of zeros and ones but slowed markedly with larger values where you increment, say, 000111111111111 to 001000000000000 and then you have a long way to go before you get back to twelve ones again. I wondered if there was a way of short circuiting the incrementation by jumping directly to the next value with the desired number of ones. After some investigation I came up with this.

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;
       };
}
[download]

It seems to work quite quickly and looks to be accurate when tested against non-short circuit methods. It was developed on 64-bit UltraSPARC so the limits are set for that architecture and may need to be reduced for other systems. Since I had never used Math::BigInt before I decided to have a crack at implementing a version that would cope with larger values of zeros and ones. It appears to run with 400 each of zeros and ones but takes some seconds per iteration (450MHz Ultra-60). Here it is.

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 $n
+umZeros);

    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;
       };
}
[download]

I've had a lot of fun exploring this problem and discovered a lot of new things, not just Perl but maths as well.

Cheers,

JohnGG