# 
# This file is part of CM-Permutation
# 
# This software is copyright (c) 2009 by Stefan Petrea.
# 
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# 
use strict;
use warnings;
package CM::Permutation;
use strict;
use warnings;
use Moose;
use List::AllUtils qw/reduce all any first uniq/;
use Carp;
use Data::Dumper;
use Math::BigInt qw/blcm/;
use CM::Permutation::Cycle_Algorithm;
#use feature 'say';
use overload    "*" => \&multiply,
                "*=" => \&mul_as,
                "**" => \&power,
                "<<" => \&conjugate,
                "==" => \&equal,
                "cmp"=> \&equal,
                "eq" => \&equal,
                '""' => 'stringify'; # "" and == are used by uniq from List::AllUtils in the tests
use Storable qw/dclone/;
use List::AllUtils qw/min max first_index/;

use 5.010000;


#////////////////////////////////////////////////////////////////////////////
#############################################################################
#this part has been generated by Dist::Zilla, I'll probably fill it out later
#############################################################################

require Exporter;
our @ISA;
push @ISA,qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

#end of Dist::Zilla  part
#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\








our $VERSION = '0.01';



has label => (
    isa => 'Str',
    is  => 'rw',
);

has perm => (
    isa => 'ArrayRef[Int]',
    is  => 'rw',
    default => sub {[]},
);


#belonging group(could be S_n or some subgroup of S_n..)
has group => (
    isa => 'Any',
    is  => 'rw',
    default => undef,
    weak_ref=> 1,
);

sub BUILDARGS {
    my ($self,@perm) = @_;

    confess "too many arguments to constructor, ambigous permutation"
        if scalar(@perm) > max(@perm);

    confess "not enough arguments to constructor, ambigous permutation"
        if scalar(@perm) < max(@perm);

    @perm = (0,@perm);
    my @m = map{0} @perm;
    {
        perm    => \@perm,
        marked  => \@m,
    }
}

sub BUILD {
    my ($self) = @_;
    #TODO -> have to make constructor accept other Permutation objects
    
    confess "duplicates are not allowed"
        unless scalar(uniq(@{ $self->perm })) == scalar(@{ $self->perm });
}

sub stringify {
    my ($self) = @_;
    my @p = @{$self->perm};
    shift @p;
    join(' ',@p);
}

sub power {
    #for now supports powers -1 and >=1
    my ($self,$power) = @_;
    return $self->inverse if $power == -1;
    

    my $r = $self;
    while(--$power) {
        my $n = $r * $self;
        $r = $n;
    };
    return $r;
}

    sub inverse {
        my ($self) = @_;
#        if($self->group && $self->label){
#            #inverse from op table
#            if($inv_cache[$self->label]){
#                return $inv_cache[$self->label];
#            };
#            my $o = $self->group->operation_table; #operation table
#            my $row = $o->[$self->group->order - $self->label];
#            my $e = $self->group->identity;
#            my $index_inverse = first_index {
#                $e->label == $_->label
#            } @$row;
#
#            $inv_cache[$self->label] = $o->[0]->[$index_inverse];
#            return $o->[0]->[$index_inverse];
#        }


        my @tuples = map { [$_,$self->perm->[$_]] } 0..-1+@{$self->perm};
        @tuples = sort { $a->[1] <=> $b->[1] } @tuples;

        shift @tuples;# get rid of first 0 , so that we can do the constructor below
        my $inverse = CM::Permutation->new( map{ $_->[0] } @tuples );

        return $inverse;
    }

# TODO:need check that both @_ are C::P
sub equal {
    if($_[0]->label && $_[1]->label) {
#        say "iar!!";
        return $_[0]->label == $_[1]->label;
    };
    my ($self,$other) = @_;
    return 0 if scalar(@{$self->perm}) != scalar(@{$other->perm});
    return all { ; $self->perm->[$_] == $other->perm->[$_] } 0..-1+@{$other->perm};
}



#TODO: profiling already done...remains to root out the cause of low speed
sub multiply {
    # the naming $right , $left is weird but it corresponds to order of elements in multiplication
#    if($_[0]->label && $_[1]->label && $_[0]->group) {
#        say "called";
##        say $_[0]->label;
##        say $_[1]->label;
#
#        my $o = $_[0]->group->operation_table;
#        my $u = $_[0]->group->order;
#        return $o->[
#            $u - $_[0]->label
#        ]->[
#            $u - $_[1]->label
#        ];
#    };

    my ($right,$left) = @_;
    return CM::Permutation->new(
        map {
            my $i = $_;
            $right->perm->[
                $left->perm->[$i]
            ];
        } 1..max(@{ $right->perm })
    );
}

######################################################################
#this is somewhat asymettrical because Cycle derives from Permutation
#but order() in Cycle is used by order() in Permutation
######################################################################

sub order {
    #
    #sidenote: the maximum order of an element in S_n can be determined by taking
    #all partitions of n and computing lcm of each partitions elements and the biggest lcm
    #is the maximum order of an element in S_n
    #(this is because every permutation is the product of disjoint cycles, and order of the cycles is their own
    #length, and the sums of their orders must add up to n)
    #
    #
    my ($self) = @_;
    my @v = @{$self->perm};
    shift @v;
    my $alg = CM::Permutation::Cycle_Algorithm->new(@v);
    blcm(map { #print "$_ ->".$_->order."\n"; 
            $_->order;  } $alg->run);
}

# for some reason mul_as doesn't work

sub mul_as {
    $_[0] = $_[0] * $_[1];
}


# if there is a g \in G so that  g*a*g^-1 = b then a ~ b (a and b are conjugates)

sub conjugate {
    my ($a,$b) = @_;# $a is actually $self
    confess 'a undefined' unless $a;
    confess 'b undefined' unless $b;
    confess 'no group for a' unless $a->group;
    confess 'no group for b' unless $b->group;
    #confess "element doesn't have a group" unless $a->group ;
#    say Dumper $a->group;
#    say Dumper $b->group;
#    exit;
    my $i = 0;
    return first {
#        say $i++;
        $_*$a*($_**-1) == $b
    } @{$a->group->elements};
}



=pod

=head1 NAME

CM::Permutation - Module for manipulating permutations 

=head1 VERSION

version 0.051

=head1 DESCRIPTION

The module was written for carrying out permutation operations.
The module is not written for generating permutations or counting them(to that end you can use L<Algorithm::Permute> or L<Math::Counting>)

At the moment the following are implemented(any feature that is currently listed as implemented has tests proving it):

=over

=item * permutation composition and conjugate permutations

=item * inverse of a permutation

=item * cycle decomposition

=item * power of a permutation

=item * '==' operator implemented (eq is the same)

=back


=head1 TODO

=over

=item * breaking cycles into transpositions( maybe making a transposition class)

=item * write a routine to count inversions and then even() and odd() methods for CM::Permutation

=item * writing as much tests as possible

=item * writing routine is_cycle() to check if a permutation is a cycle

=item * get Cycle_Algorithm to use ArrayRef[CM::Permutation::Cycle] instead of what it's using now for storing the cycles and re-write tests

=item * add order() method for ::Permutation (will be different for ::Permutation::Cycle , where just the length is the order) and will be computed as gcd of lenghts of cycles.::Permutation (will be different for ::Permutation::Cycle , where just the length is the order) and will be computed as gcd of lenghts of cycles.

=back


=head1 AUTHOR

Stefan Petrea, C<< <stefan.petrea at gmail.com> >>

=head1 SEE ALSO

L<Algorithm::Permute> or L<Math::Counting> 

L<http://en.wikipedia.org/wiki/Cycle_(mathematics)>

=cut

1;