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 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; }; }
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 |