Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Re: One Zero variants_without_repetition

by johngg (Canon)
on Aug 14, 2007 at 23:02 UTC ( #632615=note: print w/replies, xml ) Need Help??


in reply to One Zero variants_without_repetition

After my first woeful attempt at a solution I continued to work at this problem. Moving away from the substr 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 here.

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 (Pope) on Aug 14, 2007 at 23:37 UTC

    Superb++.

    I did a differential analysis, subtracting the numerical value of successive binary strings that met the criteria, and started to see a pattern emerge that seemed to be keyed to 2**N where N was the number of 0s or 1s depending upon whether iterating up or down.

    But there was always some odd adjustments required at the start and end of each run which I couldn't tie down the pattern to. Then the OP started talking about infinite compression algorithms and I lost interest :)


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      sorry for disappointing you. it ain't that infinite, just a compression which "wraps 0's and 1's into smth logical that can be compressed again up to the smallest value.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://632615]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2020-07-10 12:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?