Rate salva1 tybalt89_re choroba Eily tybalt89 GrandFather salva2 salva0
salva1 1085/s -- -27% -28% -63% -64% -81% -82% -82%
tybalt89_re 1491/s 37% -- -1% -49% -51% -74% -75% -75%
choroba 1500/s 38% 1% -- -49% -51% -74% -75% -75%
Eily 2936/s 171% 97% 96% -- -3% -49% -51% -52%
tybalt89 3036/s 180% 104% 102% 3% -- -47% -50% -50%
GrandFather 5771/s 432% 287% 285% 97% 90% -- -4% -5%
salva2 6036/s 456% 305% 302% 106% 99% 5% -- -1%
salva0 6084/s 461% 308% 305% 107% 100% 5% 1% --
####
my %cache;
sub salva2 {
my ($len, $ones) = @_;
$cache{$len, $ones} //= do {
if ($len > $ones) {
if ($ones) {
[ map("1$_", @{salva2($len - 1, $ones - 1)}),
map("0$_", @{salva2($len - 1, $ones)})];
} else {
[ "0" x $len ]
}
} else {
[ "1" x $len ]
}
}
}
##
##
#!/usr/bin/perl
use warnings;
use strict;
sub salva1 {
my ($length, $ones) = @_;
my $str = "0" x $length;
my $start = $str . "1";
my @r;
while (1) {
push @r, $str if $ones == $str =~ tr/1//;
$str =~ s/^(1*0)/substr($start, -length($1))/e or last
}
return \@r
}
sub salva0 {
my ($length, $ones) = @_;
my $str = ("1" x $ones) . ("0" x ($length - $ones));
my @r;
do {
push @r, $str
} while ($str =~ s/^(0*)(1*)10/${2}${1}01/);
return \@r
}
my %cache;
sub salva2 {
my ($len, $ones) = @_;
my $ref = $cache{$len, $ones} //= do {
if ($len > $ones) {
if ($ones) {
[ map("1$_", @{salva2($len - 1, $ones - 1)}),
map("0$_", @{salva2($len - 1, $ones)})];
} else {
[ "0" x $len ]
}
} else {
[ "1" x $len ]
}
};
$ref
}
sub salva2_clear {
%cache = ();
salva2(@_)
}
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);
next unless $ones == $n =~ tr/1//;
push @r, $n;
}
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
}
# use List::Util qw{ uniq };
# sub Discipulus {
# my ($length, $ones) = @_;
# [ uniq map { join "", @$_ } permutations( [ (0) x ($length - $ones), (1) x $ones] ) ]
# }
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 = join '', ('(1?)') x $length;
(1 x $ones) =~ /^$pattern$(?{
push @strings, join '', map $_ || 0, @{^CAPTURE};
})(*FAIL)/x;
return \@strings
}
use Test::More;
use Test::Deep;
my $len = 10;
my $ones = 4;
cmp_deeply
salva0($len,$ones),
bag(@{ GrandFather($len, $ones) });
cmp_deeply
salva1($len, $ones),
bag(@{ GrandFather($len, $ones) });
cmp_deeply
salva2_clear($len, $ones),
bag(@{ GrandFather($len, $ones) });
cmp_deeply
choroba($len, $ones),
bag(@{ GrandFather($len, $ones) });
cmp_deeply
Eily($len, $ones),
bag(@{ GrandFather($len, $ones) });
# cmp_deeply
# Discipulus($len, $ones),
# bag(@{ GrandFather($len, $ones) });
cmp_deeply
tybalt89($len, $ones),
bag(@{ GrandFather($len, $ones) });
cmp_deeply
tybalt89_re($len, $ones),
bag(@{ GrandFather($len, $ones) });
done_testing();
use Benchmark qw{ cmpthese };
cmpthese(-3, {
salva0 => sub { salva0($len, $ones) },
salva1 => sub { salva1($len, $ones) },
salva2 => sub { salva2_clear($len, $ones) },
choroba => sub { choroba($len, $ones) },
GrandFather => sub { GrandFather($len, $ones) },
Eily => sub { Eily($len, $ones) },
# Discipulus => sub { Discipulus($len, $ones) },
tybalt89 => sub { tybalt89($len, $ones) },
tybalt89_re => sub { tybalt89_re($len, $ones) },
});