groups.p6

role Group {
    method elements { ... }
    method id { ... }
    method op($l, $r) { ... }
}

macro assert($fact) {
    quasi {
        die "FAILED: ", $fact.Str
            unless {{{$fact}}};
    }
}

role Group::Laws[Group $group] {
    my $id = $group.id;
    my @el = $group.elements;
    my $set = set @el;

    sub infix:<∘>($l, $r) { $group.op($l, $r) }

    method check_identity_does_nothing {
        for @el -> $e {
            assert $id ∘ $e eqv $e;
            assert $e ∘ $id eqv $e;
        }
    }

    method check_operation_is_closed {
        for @el X @el -> $a, $b {
            assert $a ∘ $b ∈ $set;
        }
    }

    method check_operation_is_associative {
        for @el X @el X @el -> $a, $b, $c {
            assert ($a ∘ $b) ∘ $c eqv $a ∘ ($b ∘ $c);
        }
    }
}

class CyclicGroup does Group {
    has Int $.order;

    method elements { 0 ..^ $.order }
    method id { 0 }
    method op($l, $r) { ($l + $r) % $.order }

    method Str { "C($.order)" }
    method gist { $.Str }
}

class Pair::Cartesian {
    has $.e1;
    has $.e2;

    method Str { "($.e1, $.e2)" }
}

sub pair($e1, $e2) { Pair::Cartesian.new(:$e1, :$e2) }

multi infix:<eqv>(Pair::Cartesian $p1, Pair::Cartesian $p2) {
    $p1.e1 eqv $p2.e1 && $p1.e2 eqv $p2.e2;
}

class ProductGroup does Group {
    has Group $.g1;
    has Group $.g2;

    method elements {
        gather for $.g1.elements X $.g2.elements -> $e1, $e2 {
            take pair($e1, $e2);
        }
    }

    method id { pair($.g1.id, $.g2.id) }

    method op($l, $r) {
        pair(
            $.g1.op($l.e1, $r.e1),
            $.g2.op($l.e2, $r.e2),
        )
    }

    method Str { "<$.g1 ✕ $.g2>" }
    method gist { $.Str }
}

sub C($order) { CyclicGroup.new(:$order) }
sub infix:<✕>(Group $g1, Group $g2) { ProductGroup.new(:$g1, :$g2) }

class Mapping {
    has %.mapping;

    method new($g1, $g2, @perm) {
        my @e1 = $g1.elements;
        my @e2 = $g2.elements;

        my %mapping;
        for ^@perm -> $i {
            my $e1 = @e1[$i];
            my $e2 = @e2[@perm[$i]];

            %mapping{~$e1} = $e2;
        }
        $.bless(:%mapping);
    }

    method translate($e) {
        return %.mapping{$e};
    }

    method Str {
        my $result = "";
        my $*OUT = role { method print(*@a) { $result ~= @a } };

        for %.mapping.keys.sort -> $e1 {
            my $e2 = $.translate($e1);
            say "$e1 => $e2";
        }

        return $result;
    }
}

sub isomorphic($g1, $g2) {
    my @e1 = $g1.elements;
    my @e2 = $g2.elements;

    return False
        if @e1 != @e2;
    my $order = +@e1;

    sub infix:<∘>($l, $r) { $g1.op($l, $r) }
    sub infix:<·>($l, $r) { $g2.op($l, $r) }

    MAPPING:
    for permutations($order) -> @perm {
        my $mapping = Mapping.new($g1, $g2, @perm);
        sub t($e) { $mapping.translate($e) }

        next MAPPING
            unless t($g1.id) eqv $g2.id;

        for ^$order X ^$order -> $i1, $i2 {
            my $e1 = @e1[$i1];
            my $e2 = @e1[$i2];

            next MAPPING
                unless t($e1 ∘ $e2) eqv t($e1) · t($e2);
        }
        return $mapping;
    }

    return False;
}

sub infix:<≅>($g1, $g2) { isomorphic $g1, $g2 }

{
    my $c6 = C(6);
    my $c2_x_c3 = C(2) ✕ C(3);

    for $c6, $c2_x_c3 -> $group {
        my $laws = Group::Laws[$group];
        $laws.check_identity_does_nothing;
        $laws.check_operation_is_closed;
        $laws.check_operation_is_associative;

        say "$group satisfies the group laws";
    }

    if my $mapping = $c6 ≅ $c2_x_c3 {
        say "$c6 ≅ $c2_x_c3";
        say "Mapping:";
        say $mapping.Str.indent(4);
    }
    else {
        say "$c6 ≇ $c2_x_c3";
    }
}

{
    my $c8 = C(8);
    my $c2_x_c4 = C(2) ✕ C(4);

    if my $mapping = $c8 ≅ $c2_x_c4 {
        say "$c8 ≅ $c2_x_c4";
    }
    else {
        say "$c8 ≇ $c2_x_c4";
    }
}