Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
And here's a benchmark:
#!/usr/bin/perl use warnings; use strict; sub salva { my ($length, $ones) = @_; my $str = ("1" x $ones) . ("0" x ($length - $ones)); my @r; while(1) { push @r, $str; $str =~ s/^(0*)(1*)10/${2}${1}01/ or last; } return \@r } sub increment { my $pos = rindex $_[0], 0; if ($pos > -1) { substr $_[0], $pos, 1, '1'; substr $_[0], $pos + 1, length($_[0]) - $pos - 1, '0' x (length($_[0]) - $pos - 1); } else { $_[0] = '1' . ('0' x length $_[0]); } } sub choroba { my ($length, $ones) = @_; my @r; my $n = '0' x $length; while ($length == length $n) { increment($n); push @r, $n if $ones == $n =~ tr/1//; } return \@r } sub GrandFather { my ($strLen, $numOnes) = @_; my @strings; for my $prefixSize (0 .. $strLen - $numOnes) { my $prefix = '0' x $prefixSize; my $tailLen = $strLen - $prefixSize - 1; if ($numOnes == 1) { push @strings, $prefix . '1' . ('0' x $tailLen); } else { push @strings, map {$prefix . '1' . $_} @{ GrandFather($tailLen, $numOnes - 1) }; } } return \@strings } use Algorithm::Combinatorics qw{ combinations permutations }; sub Eily { my ($length, $ones) = @_; my $iter = combinations([0..$length-1], $ones); my @r; while (my $positions = $iter->next) { my @data = (0,) x $length; $data[$_] = 1 for @$positions; push @r, join "", @data; } return \@r } sub Discipulus { my ($length, $ones) = @_; my %seen; @seen{ map { join "", @$_ } permutations( [ (0) x ($length - $ones), (1) x $ones] ) } = (); [ keys %seen ] } sub _tybalt89 { my ($length, $ones) = @_; $length <= $ones ? 1 x $length : $ones < 1 ? 0 x $length : ( map("1$_", _tybalt89( $length - 1, $ones - 1 ) ), map "0$_", _tybalt89( $length - 1, $ones ) ) } sub tybalt89 { [ _tybalt89(@_) ] } sub tybalt89_re { my ($length, $ones) = @_; my @strings; my $pattern = '(1?)' x $length; (1 x $ones) =~ /^$pattern$(?{ push @strings, join '', map $_ || 0, @{^CAPTU +RE}; })(*FAIL)/x; return \@strings } sub tybalt2 { my @strings = ''; my $zeros = $_[0] - $_[1]; my $ones = $_[1]; @strings = map +( ($@ = tr/1//) < $ones ? $_.1 : (), length($_) - $@ < $zeros ? $_.0 : () ), @strings for 1 .. $_[0]; return \@strings } sub Eily_LanX { my ($length, $ones) = @_; my $iter = combinations([0..$length-1], $ones); my (@r, $str); while (my $positions = $iter->next) { $str = '0' x $length; substr $str, $_, 1, '1' for @$positions; push @r, $str; } return \@r } sub johngg { my ($length, $ones) = @_; my $zeros = $length - $ones; my $rcNextPerm = _johngg($zeros, $ones); my @r; push @r, $_ while $_ = $rcNextPerm->(); \@r } sub _johngg { 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 } } sub Tux { my ($length, $ones) = @_; [ map { substr unpack ("b*", $_), 0, $length } grep { $ones == unpack "%32b*" => $_ } map { pack "L<", $_ } 0 .. oct "0b".join""=> (1) x $ones, (0) x ($length - $ones) ] } use Test::More; use Test::Deep; cmp_deeply salva(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply GrandFather(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply Eily(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply Discipulus(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply tybalt89(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply tybalt89_re(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply tybalt2(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply Eily_LanX(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply johngg(10, 3), bag(@{ choroba(10, 3) }); cmp_deeply Tux(10, 3), bag(@{ choroba(10, 3) }); done_testing(); use Benchmark qw{ cmpthese }; cmpthese(-3, { salva => sub { salva(10, 3) }, choroba => sub { choroba(10, 3) }, GrandFather => sub { GrandFather(10, 3) }, Eily => sub { Eily(10, 3) }, Discipulus => sub { Discipulus(10, 3) }, tybalt89 => sub { tybalt89(10, 3) }, tybalt89_re => sub { tybalt89_re(10, 3) }, tybalt2 => sub { tybalt2(10, 3) }, Eily_LanX => sub { Eily_LanX(10, 3) }, johngg => sub { johngg(10, 3) }, Tux => sub { Tux(10, 3) }, });
Rate Discipulus tybalt89_re choroba Tux johngg Ei +ly tybalt89 Eily_LanX GrandFather salva tybalt2 Discipulus 9.54e-02/s -- -100% -100% -100% -100% -10 +0% -100% -100% -100% -100% -100% tybalt89_re 1321/s 1383857% -- -2% -47% -51% -5 +1% -58% -71% -76% -79% -80% choroba 1346/s 1410770% 2% -- -46% -50% -5 +0% -57% -70% -76% -78% -80% Tux 2472/s 2590190% 87% 84% -- -9% - +9% -21% -45% -55% -60% -63% johngg 2709/s 2839387% 105% 101% 10% -- - +0% -13% -40% -51% -56% -60% Eily 2715/s 2845137% 106% 102% 10% 0% +-- -13% -40% -51% -56% -60% tybalt89 3130/s 3280107% 137% 132% 27% 16% 1 +5% -- -31% -44% -49% -54% Eily_LanX 4509/s 4725725% 241% 235% 82% 66% 6 +6% 44% -- -19% -27% -33% GrandFather 5547/s 5813004% 320% 312% 124% 105% 10 +4% 77% 23% -- -10% -18% salva 6179/s 6475626% 368% 359% 150% 128% 12 +8% 97% 37% 11% -- -9% tybalt2 6763/s 7088014% 412% 402% 174% 150% 14 +9% 116% 50% 22% 9% --
map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

In reply to Re: Generate all unique combinations of 1 and 0 using specified length of "0"-string and count of 1's [Updated] by choroba
in thread Generate all unique combinations of 1 and 0 using specified length of "0"-string and count of 1's by Lana

Title:
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?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (4)
As of 2022-12-09 02:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?