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) }, });