#  Copyright (c) 1997-2020
#  Ewgenij Gawrilow, Michael Joswig, and the polymake team
#  Technische Universität Berlin, Germany
#  https://polymake.org
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#-------------------------------------------------------------------------------

# @category Symmetry
# Construct the induced action of a permutation action on a property that is an ordered collection of sets,
# such as MAX_INTERIOR_SIMPLICES
# @param polytope::Cone c the cone or polytope
# @param PermutationAction a a permutation action on, for example, the vertex indices
# @param String domain the property the induced action should act upon
# @return PermutationActionOnSets
# @example [application polytope] > $c=cube(3, group=>1, character_table=>0);
# > group::induce_set_action($c, $c->GROUP->VERTICES_ACTION, "MAX_INTERIOR_SIMPLICES")->properties();
# | name: induced_set_action_of_ray_action_on_MAX_INTERIOR_SIMPLICES
# | type: PermutationActionOnSets
# | description: induced from ray_action on MAX_INTERIOR_SIMPLICES
# |
# | DOMAIN_NAME
# | MAX_INTERIOR_SIMPLICES
# |
# | GENERATORS
# | 5 4 7 6 1 0 3 2 11 10 9 8 30 29 32 31 38 40 39 41 33 36 35 34 37 43 42 45 44 13 12 15 14 20 23 22 21 24 16 18 17 19 26 25 28 27 49 48 47 46 55 54 57 56 51 50 53 52
# | 0 2 1 3 12 14 13 15 16 17 18 19 4 6 5 7 8 9 10 11 21 20 22 24 23 25 27 26 28 29 31 30 32 34 33 35 37 36 46 47 48 49 50 52 51 53 38 39 40 41 42 44 43 45 54 56 55 57
# | 0 4 8 9 1 5 10 11 2 3 6 7 16 20 25 26 12 17 21 27 13 18 22 23 28 14 15 19 24 33 38 42 43 29 34 35 39 44 30 36 40 45 31 32 37 41 50 51 54 55 46 47 52 56 48 49 53 57

user_function induce_set_action($, $, String; { store_index_of => 0 } ) {
    my ($c, $action, $domain_name, $options) = @_;
    my $dom = $c->give($domain_name);
    my $iod = index_of($dom);
    my $ia = new PermutationActionOnSets("induced_set_action_of_" . $action->name . "_on_$domain_name");
    $ia->GENERATORS = induced_permutations($action->GENERATORS, $dom, $iod);
    $ia->DOMAIN_NAME = $domain_name;
    $ia->description = "induced from " . $action->name . " on $domain_name";

    if (defined($action->lookup("CONJUGACY_CLASS_REPRESENTATIVES"))) {
        $ia->CONJUGACY_CLASS_REPRESENTATIVES = induced_permutations($action->CONJUGACY_CLASS_REPRESENTATIVES, $dom, $iod);
    }

    if ($options->{"store_index_of"}) {
        $ia->INDEX_OF = $iod;
    }

    if (!defined($c->give("GROUP.SET_ACTION", sub { $_->DOMAIN_NAME eq $domain_name } ))) {
        $c->GROUP->add("SET_ACTION", $ia);
    }

    return $ia;
}

function induce_permutation_action($$$$$; $=0, $=0) {
    my ($this, $from_action, $on_section, $name, $desc, $homogeneous_action, $canon) = @_;
    my $a = new PermutationAction($name);
    my $on = $this->$on_section;
    if (ref($canon) eq 'CODE') {
        # need a copy
        $on = $on->type->construct->($on);
        $canon->($on);
    }
    $a->GENERATORS = induced_permutations($this->GROUP->$from_action->GENERATORS, $on, homogeneous_action=>$homogeneous_action);
    if (defined(my $cc = $this->lookup("GROUP." . $from_action . ".CONJUGACY_CLASS_REPRESENTATIVES"))) {
        $a->CONJUGACY_CLASS_REPRESENTATIVES = induced_permutations($cc, $on, homogeneous_action=>$homogeneous_action);
    }
    $a->description = $desc;
    return $a;
}

# helper function: Is a matrix a unit matrix?
function is_unit_matrix(Matrix) {
    my $m = shift;
    return ($m == unit_matrix<$m->type->params->[0]>($m->rows)) ? 1 : 0;
}

# helper function: Is a matrix a unit matrix?
function is_unit_matrix(Matrix<Float>) {
    my $m = shift;
    my $app = new ApproximateSet<Matrix<Float>>;
    $app += unit_matrix<Float>($m->rows);
    $app += $m;
    return ($app->size() != 1) ? 0 : 1;
}

# helper function: is the order of a matrix equal to the order of a permutation?
function check_generator_order<Scalar>(Array<Int>, Matrix<Scalar>) {
    my ($perm, $candidate_gen) = @_;
    my $product = new Matrix<Scalar>($candidate_gen);
    foreach (2..permutation_order($perm)) {
        $product = $product * $candidate_gen; # can't use *= here, don't know why
    }
    if (!is_unit_matrix($product)) {
        croak("The matrix\n$candidate_gen\ncorresponding to the generator $perm has the wrong order. Thus, the given permutations do not induce a matrix action. Please check your assumptions, especially if the embedding of your polytope is really regular.");
    }
    return 1;
}

# convert an array of permutations of indices to an array of matrices acting on vertices/points
function perms2matrices<Scalar>(Matrix<Scalar>, Array<Array<Int>>, Matrix<Scalar>) {
    my ($pts_or_verts, $perms, $kernel) = @_;
    my @gens;
    my $pts_plus_kernel = $kernel->rows != 0 ? new Matrix<Scalar>($pts_or_verts/$kernel) : $pts_or_verts;
    foreach (@{$perms}) {
        my $candidate_gen = solve_right($pts_plus_kernel,
                                        $kernel->rows != 0 ? new Matrix<Scalar>(permuted_rows($pts_or_verts, $_)/$kernel)
                                                           : permuted_rows($pts_or_verts, $_));   # $pts_plus_kernel * X = pi($pts_plus_kernel)
        if (check_generator_order($_, $candidate_gen)) {
            push @gens, $candidate_gen;
        }
    }
    return new Array<Matrix<Scalar>>(\@gens);
}

function induce_matrix_action<Scalar>($$$ Matrix<Scalar>) {
    my ($this, $from_action, $from_section, $kernel) = @_;
    my $a = new MatrixActionOnVectors<Scalar>("matrix_action");
    $a->GENERATORS = perms2matrices($this->$from_section,
                                    $this->GROUP->$from_action->GENERATORS,
                                    $kernel);
    if (defined(my $cc = $this->lookup("GROUP.$from_action.CONJUGACY_CLASS_REPRESENTATIVES"))) {
        $a->CONJUGACY_CLASS_REPRESENTATIVES = perms2matrices($this->$from_section,
                                                             $this->GROUP->$from_action->CONJUGACY_CLASS_REPRESENTATIVES,
                                                             $kernel);
    }
    $a->description = "induced from action on $from_section";
    return $a;
}

# @category Symmetry
# Construct an implicit action of the action induced on a collection of sets. Only a set of
# orbit representatives is stored, not the full induced action.
# @param PermutationAction original_action the action of the group on indices
# @param String property the name of a property that describes an ordered list of sets on which the group should act
# @return ImplicitActionOnSets the action of the group on the given property, such that only representatives are stored
# @example [application polytope] To construct the implicit action of the symmetry group of a cube on its maximal simplices, type:
# > $c=cube(3, group=>1, character_table=>0);
# > group::induce_implicit_action($c, $c->GROUP->VERTICES_ACTION, $c->GROUP->REPRESENTATIVE_MAX_INTERIOR_SIMPLICES, "MAX_INTERIOR_SIMPLICES")->properties();
# | name: induced_implicit_action_of_ray_action_on_MAX_INTERIOR_SIMPLICES
# | type: ImplicitActionOnSets
# | description: induced from ray_action on MAX_INTERIOR_SIMPLICES
# |
# | DOMAIN_NAME
# | MAX_INTERIOR_SIMPLICES
# |
# | EXPLICIT_ORBIT_REPRESENTATIVES
# | {0 1 2 4}
# | {0 1 2 5}
# | {0 1 2 7}
# | {0 3 5 6}
# |
# |
# | GENERATORS
# | 1 0 3 2 5 4 7 6
# | 0 2 1 3 4 6 5 7
# | 0 1 4 5 2 3 6 7

user_function induce_implicit_action<SetType>($,$, Array<SetType>, $) {
    my ($c, $original_action, $induced_dom_reps, $induced_dom_name) = @_;
    my $orig_name = $original_action->name;
    my @reps = map { new Bitset($_) } @{$induced_dom_reps};
    my $ia = new ImplicitActionOnSets("induced_implicit_action_of_" . $orig_name . "_on_$induced_dom_name");
    $ia->GENERATORS = $original_action->GENERATORS;
    $ia->DOMAIN_NAME = $induced_dom_name;
    $ia->EXPLICIT_ORBIT_REPRESENTATIVES = \@reps;
    $ia->description = "induced from $orig_name on $induced_dom_name";
    if (defined(my $cc = $original_action->lookup("CONJUGACY_CLASS_REPRESENTATIVES"))) {
        $ia->CONJUGACY_CLASS_REPRESENTATIVES = $cc;
    }
    if (!defined($c->GROUP->give("IMPLICIT_SET_ACTION", sub { $_->DOMAIN_NAME eq $induced_dom_name }))) {
        $c->GROUP->add("IMPLICIT_SET_ACTION", $ia);
    }
    return $ia;
}

# @category Symmetry
# Find the automorphism group of the graph.
# @param GraphAdjacency graph
# @return Group
user_function automorphism_group(GraphAdjacency) {
    my ($g) = @_;
    my $action = new PermutationAction(GENERATORS=>graph::automorphisms($g));
    return new Group(PERMUTATION_ACTION=>$action);
}

# @category Symmetry
# Find the automorphism group of the incidence matrix.
# @param IncidenceMatrix<NonSymmetric> m
# @param Bool on_rows true (default) for row action
# @return Group
user_function automorphism_group(IncidenceMatrix<NonSymmetric>;$) {
    my ($m,$on_rows) = @_;
    $on_rows = true if!defined($on_rows);
    my $pairs_of_gens = graph::automorphisms($m);
    my @row_gens = map {$_->first}  @$pairs_of_gens;
    my @col_gens = map {$_->second} @$pairs_of_gens;
    my $aut = $on_rows ? new PermutationAction(GENERATORS=>\@row_gens) : new PermutationAction(GENERATORS=>\@col_gens);
    return new Group(PERMUTATION_ACTION=>$aut);
}

function combinatorial_symmetries_impl($$$$) {
    my ($p, $incidences, $row_action_name, $col_action_name) = @_;
    my $pairs_of_gens = graph::automorphisms($incidences);
    my @row_gens = map {$_->first}  @$pairs_of_gens;
    my @col_gens = map {$_->second} @$pairs_of_gens;
    my $row_action = new PermutationAction(GENERATORS=>new Array<Array<Int>>(\@row_gens));
    my $col_action = new PermutationAction(GENERATORS=>new Array<Array<Int>>(\@col_gens));
    my $g = new Group("CombAut");
    $g->description="combinatorial symmetry group";
    if (!defined($p->give("GROUP", "CombAut"))) {
        $p->add("GROUP", $g, $row_action_name=>$row_action, $col_action_name=>$col_action);
    }
    return $row_action;
}

function induced_orbits_impl<Scalar>($$$, Scalar, { homog_action=>0, return_matrix=>1 }) {
    my ($c, $action_name, $generator_name, $dummy, $options) = @_;
    my $n = 0;
    my @reps = ();
    my @orbits = ();
    my @pts_in_orbit_order = ();
    my $all_pts = new Set<Vector<Scalar>>;
    foreach(@{$c->GROUP->$action_name->$generator_name}) {
        my $one_orbit;
        if ($action_name eq "MATRIX_ACTION") {
            $one_orbit = orbit($c->GROUP->$action_name->GENERATORS, new Vector<Scalar>($_));
        } elsif ($options->{homog_action} == 0) {
            $one_orbit = nonhomog_container_orbit($c->GROUP->$action_name->GENERATORS, new Vector<Scalar>($_));
        } else {
            $one_orbit = homog_container_orbit($c->GROUP->$action_name->GENERATORS, new Vector<Scalar>($_));
        }
        $all_pts += $one_orbit;
        if ($n == $all_pts->size()) {
            next;
        }
        push @reps, new Vector<Scalar>($one_orbit->[0]);

        my $orbit_indices = new Set<Int>;
        foreach($n..$n+$one_orbit->size()-1) {
            $orbit_indices += $_;
        }
        push @orbits, $orbit_indices;

        foreach(@{$one_orbit}) {
            push @pts_in_orbit_order, new Vector<Scalar>($_);
        }

        $n += $one_orbit->size();
    }
    my $a = new PermutationAction;
    $a->ORBITS = \@orbits;
    $a->EXPLICIT_ORBIT_REPRESENTATIVE_MATRIX = new Matrix<Scalar>(\@reps);
    $a->description = "induced from $action_name";
    if ($options->{return_matrix} == 1) {
        return (new Matrix<Scalar>(\@pts_in_orbit_order), $a);
    } else {
        return (\@pts_in_orbit_order, $a);
    }
}

function induced_orbits_on_vectors_impl<Scalar>(Array<Matrix<Scalar>>, Matrix<Scalar>) {
    my ($gens, $vecs) = @_;
    my @orbits;
    my $remaining_vecs = new Set<Vector<Scalar>>;
    my $index_of = new HashMap<Vector<Scalar>, Int>;
    my $index=0;
    foreach (0..$vecs->rows()-1) {
        my $v = new Vector<Scalar>($vecs->[$_]);
        $index_of->{$v} = $index++;
        $remaining_vecs += $v;
    }

    while ($remaining_vecs->size()) {
        my $o = orbit($gens, $remaining_vecs->front());
        my @orbit_inds;
        foreach my $w (@{$o}) {
            push @orbit_inds, $index_of->{$w};
        }
        push @orbits, new Set<Int>(\@orbit_inds);
        $remaining_vecs -= $o;
    }
    return new Array<Set<Int>>(\@orbits);
}

# Local Variables:
# mode: perl
# cperl-indent-level:3
# indent-tabs-mode:nil
# End: