in reply to One Zero variants_without_repetition
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; }; }
It seems to work quite quickly and looks to be accurate when tested against nonshort circuit methods. It was developed on 64bit 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 Ultra60). 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; }; }
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


Replies are listed 'Best First'.  

Re^2: One Zero variants_without_repetition
by BrowserUk (Patriarch) on Aug 14, 2007 at 23:37 UTC  
by thenetfreaker (Friar) on Aug 15, 2007 at 16:55 UTC  
by BrowserUk (Patriarch) on Aug 15, 2007 at 17:40 UTC 