1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#!/usr/local/bin/perl
use strict;
use warnings;

my @bits;
my $n  = shift || 3;
my $n2 = $n * $n;
my $cnt = 0;

sub comb {
    my ($a, $k, $s, $b) = @_;
    if ($k < $n-1){
        comb($_+1, $k+1, $s-$_, $b|1<<($_+1)) for ($a .. $n2-1);
    }else{
        push @bits, $b|1<<($s+1) if $a <= $s && $s <= $n2;
    }
}

sub calc{
    my ($s, $k, $b) = @_;
    if ($k == $n){
        printf "%d\r", $cnt++;
        return;
    }
    for my $i ($s..@bits-1){
        next if $b & $bits[$i];
        calc($i, $k+1, ($b | $bits[$i]));
    }
}

comb(1, 0, ($n * ($n2+1) / 2), 0);
@bits = sort {$a <=> $b} @bits;
calc(0, 0, 0);
print "$cnt\n";