Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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.



In reply to Re: One Zero variants_without_repetition by johngg
in thread One Zero variants_without_repetition by thenetfreaker

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (5)
As of 2023-01-28 00:00 GMT
Find Nodes?
    Voting Booth?

    No recent polls found