use warnings;
use strict;
sub perm_decode {
my(@perm) = @_;
my($n, $k, $b, $v, $e);
($n, $k, $b, $v) = (0, 0, 0, 0);
for $e (@perm) {
#$b == choose($n, $k - 1) or die "assertion failed";
$e or $v += $b;
$n++;
$e and $k++;
$b = $k <= 1 ?
($k < 1 ? 0 : 1) :
($b * $n / ($e ? $k - 1 : $n - $k + 1));
}
$b = $k <= 0 ? 1 : ($b * ($n - $k + 1)) / $k;
#$b == choose($n, $k) or die "assertion failed";
$n, $k, $v, $b;
}
sub perm_encode {
my($n, $k, $v) = @_;
my(@r, $bi);
while (0 < $n) {
$n--;
$bi = choose($n, $k - 1);
if ($v < $bi) {
unshift @r, 1;
$k--;
} else {
$v -= $bi;
unshift @r, 0;
}
}
@r;
}
####
# 2**28 < fact(12) < 2**29 < 2**32 < fact(13) < 2**33 <
# < 2**52 < fact(18) < 2**53 < 2**56 < fact(19) < 2**57
sub choose {
my($n, $k) = @_;
my($v, $l);
$k < 0 and return 0;
$v = 1;
$n - $k < $k and
$k = $n - $k;
for $l ($n - $k + 1 .. $n)
{ $v *= $l; }
for $l (2 .. $k)
{ $v /= $l; }
$v;
}
sub each_variation {
my($n, $callb) = @_;
my(@a, $k);
@a = (0) x $n;
OUT: while (1) {
&$callb(@a);
$k = $n;
IN: {
0 <= --$k or last OUT;
2 == ++$a[$k] and do { $a[$k] = 0; redo IN; };
}
}
}
if (1) {
my(@k, @p, @pp, $r, @r, $n);
for $n (0 .. 6) {
#warn "= $n";
@r = ();
each_variation($n, sub {
@p = @_;
@k = perm_decode(@p);
$r = sprintf "%1d %1d %2d %2d : %s\n",
@k[0 .. 3], join(" ", @p);
push @r, $r;
});
print sort @r;
}
}
if (0) {
my(@k, @p, @pp, $r, @r, $n);
for $n (0 .. 60) {
warn "= $n";
@r = ();
each_variation($n, sub {
@p = @_;
@k = perm_decode(@p);
@pp = perm_encode(@k);
$r = sprintf "%1d %1d %2d : %s : %s\n",
@k[0 .. 2], join(" ", @p), join(" ", @pp);
join(",", @p) eq join(",", @pp) or do {
$r = sprintf "%1d %1d %2d : %s : %s\n",
@k[0 .. 2], join(" ", @p), join(" ", @pp);
die "perm_encode wrong: $r";
};
});
warn "ok";
};
}
if (0) {
my($n, $k);
for $n (0 .. 15) {
for $k (0 .. $n) {
printf "% 5d", choose($n, $k);
}
print "\n";
}
}
if (0) {
# 9 3 27
my($n, $k, $b, $v, @p, $nn, $kk, $vv);
$b = choose(($n, $k) = (9, 3));
for $v (27 .. 28) {
@p = perm_encode($n, $k, $v);
($nn, $kk, $vv) = perm_decode(@p);
printf "%d %d %2d : %d %d %2d : %s\n",
$n, $k, $v, $nn, $kk, $vv, join(" ", @p);
}
warn join(" ", perm_decode(perm_encode(9, 3, 28)));
}
__END__
##
##
sub word_to_indicator {
my($n, $w) = @_;
my($p, $d) = 0;
reverse map {
$p += $d = chr(ord("A") + $_) eq substr($w, $p, 1) ? 1 : 0;
$d;
} 0 .. $n - 1;
}
if (1) {
# here, N = 5, K = 2.
my @combination = qw{AB AC AD AE BC BD BE CD CE DE};
for my $combination (@combination) {
my @indicator = word_to_indicator(5, $combination);
my($N, $K, $rank, $C) = perm_decode(@indicator);
print "$combination : @indicator : $N $K $C $rank\n";
}
}