note
choroba
And here's a benchmark:
<readmore><c>
#!/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, @{^CAPTURE};
})(*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) },
});
</c></readmore>
<c>
Rate Discipulus tybalt89_re choroba Tux johngg Eily tybalt89 Eily_LanX GrandFather salva tybalt2
Discipulus 9.54e-02/s -- -100% -100% -100% -100% -100% -100% -100% -100% -100% -100%
tybalt89_re 1321/s 1383857% -- -2% -47% -51% -51% -58% -71% -76% -79% -80%
choroba 1346/s 1410770% 2% -- -46% -50% -50% -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% 15% -- -31% -44% -49% -54%
Eily_LanX 4509/s 4725725% 241% 235% 82% 66% 66% 44% -- -19% -27% -33%
GrandFather 5547/s 5813004% 320% 312% 124% 105% 104% 77% 23% -- -10% -18%
salva 6179/s 6475626% 368% 359% 150% 128% 128% 97% 37% 11% -- -9%
tybalt2 6763/s 7088014% 412% 402% 174% 150% 149% 116% 50% 22% 9% --
</c>
<!-- Node text goes above. Div tags should contain sig only -->
<div class="pmsig"><div class="pmsig-832495">
<c>map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]</c>
</div></div><!-- Wiki2Monks {"version":1.16} -->
11121888
11121888