#!/usr/bin/env perl

use Modern::Perl 2018;
use CInet::Base;
use CInet::ManySAT;

use List::Util qw(minstr uniqstr);
use Array::Set qw(set_diff set_union set_intersect set_symdiff);
use Algorithm::Combinatorics qw(subsets permutations);

my $cube = Cube(3);
my $N = $cube->set;

my @group;
for my $Z (subsets($N)) {
    for my $p (permutations $N) {
        push @group, [$p, $Z];
    }
}

sub act {
    my ($V, $p, $Z) = @_;

    my $z = $cube->pack([ [], $Z ]) - 1;
    my $W = [ @$V ];
    for my $K (subsets($N)) {
        my $k = $cube->pack( $cube->permute($p => [ [], $K ]) ) - 1;
        my $zk = $cube->pack([ [], set_symdiff($Z, $K) ]) - 1;
        my $c = (set_intersect($Z, $K)->@* % 2) == 0 ? +1 : -1;
        $W->[$k] = $V->[$z] * $V->[$zk] * $c;
    }
    $W
}

sub to_str {
    join '', map { $_ > 0 ? '+' : '-' } shift->@*
}

my $sat = CInet::ManySAT->new;
# The empty set is always positive.
$sat->add([ $cube->pack([ [], [  ] ]) ]);
# Diamond property:
for my $A (subsets($N)) {
    next if @$A > @$N - 2;
    for my $ij (subsets(set_diff($N, $A), 2)) {
        # CNF of (A = ijA) => (iA = jA) for boolean variables ijA, iA, jA, A.
        my $a   = $cube->pack([ [], $A ]);
        my $ia  = $cube->pack([ [], set_union($A, [$ij->[0]]) ]);
        my $ja  = $cube->pack([ [], set_union($A, [$ij->[1]]) ]);
        my $ija = $cube->pack([ [], set_union($A, [$ij->@* ]) ]);
        $sat->add([  $a,  $ija,  $ia, -$ja ]);
        $sat->add([  $a,  $ija, -$ia,  $ja ]);
        $sat->add([ -$a, -$ija,  $ia, -$ja ]);
        $sat->add([ -$a, -$ija, -$ia,  $ja ]);
    }
}

# Compute all hyperoctahedral orbits.
my $all = $sat->all;
my (%orbits, %reps);
while (defined(my $v = $all->next)) {
    my $V = [ map { $_ > 0 ? 1 : -1 } $v->@* ];
    next if defined $reps{to_str $V};
    my @orbit = uniqstr sort map { to_str act($V, @$_) } @group;
    my $rep = minstr @orbit;
    $reps{$_} = $rep for @orbit;
    push $orbits{$rep}->@*, $_ for @orbit;
}

# We know these values from a CAD.
for my $rep (sort keys %orbits) {
    if ($rep eq '++++++++') {
        say "'$_' => 1," for $orbits{$rep}->@*;
    }
    elsif ($rep eq '+++++++-') {
        say "'$_' => 4," for $orbits{$rep}->@*;
    }
    elsif ($rep eq '++++++--') {
        say "'$_' => 2," for $orbits{$rep}->@*;
    }
    elsif ($rep eq '+++++---') {
        say "'$_' => 4," for $orbits{$rep}->@*;
    }
    elsif ($rep eq '++++----') {
        say "'$_' => 16," for $orbits{$rep}->@*;
    }
    else {
        die 'unexpected representative';
    }
}