note
johngg
After my first woeful [id://631126|attempt] at a solution I continued to work at this problem. Moving away from the <c>substr</c> idea I started to look at incrementing from the lowest possible value, e.g. with three each of zeros and ones, 000111, up to the highest, 111000 picking out those numbers containing exactly three ones. [BrowserUk] took a similar approach [id://631016|here].<p>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.<p>
<code>
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;
};
}
</code><p>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 [doc://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.<p>
<readmore><code>
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;
};
}
</code></readmore><p>I've had a lot of fun exploring this problem and discovered a lot of new things, not just Perl but maths as well.<p>Cheers,<p>JohnGG
631006
631006