#!/usr/bin/perl
use strict;
use feature qw(say);

##
# Turns an arbitrary k-cycle into product of transpositions
# param: a single k-cycle @cycle
# returns: a product of transpositions @prod
##
sub cycle_to_trans {

    my @cycle = @_;
    my @prod = ();

    # debugging
    say "CYCLE := (",@cycle,")";

    # length of the cycle
    my $n = $#cycle;

    # (a_{1},a_{2},...,a_{n}) ==
    # [(a_{1},a_{n}), (a_{1},a_{n-1}), ..., (a_{1},a_{3}), (a_{1},a_{2})]
    for my $i ( 0 .. $n-1 ) {
    my @trans = ($cycle[0],$cycle[$n-$i]);
    push @prod, @trans;
    say "(",@trans,")";
    }
    # return the list of transpositions for this cycle
    return @prod;
}

##
# Turns a given permutation into a product of transpositions
# param: a permutation @perm
# returns: a product of transpositions @prod
##
sub perm_to_trans {

    my @perm = @_;
    my @prod = ();

    # for each cycle in trans, turn it to a transposition
    for my $aref ( @perm ) {
    my @trans = cycle_to_trans(@$aref);
    push @prod, @trans;
    }
    # return the list of transpositons for this permutation
    return @prod;
}

##
# The action of a transposition on a set
# param: a transposition @trans, a set to permute @set
# returns: the permuted set @res
##
sub swap {
    my @trans = @{ $_[0] };
    my @set = @{ $_[1] };

    my @res = ();

    my $a = @trans[0];
    my $b = @trans[1];

    # for each letter in @set
    for my $i ( 0 .. $#set ) {
    # if this letter is $a, swap it to $b
    if ( @set[$i] == $a ) {
        push @res, $b;
    }
    # if this letter is $b, swap it to $a
    elsif ( @set[$i] == $b ) {
        push @res, $a;
    }
    # otherwise, this element is fixed
    else {
        push @res, @set[$i];
    }
    }
    # debugging
    say @res;
    # return the permuted set
    return @res;
}

##
# A controller for testing.
##
sub test {
    # the permutation to use
    my @perm = ([1,5,4,2]);
    # the set to permute
    my @set = (1,2,3,4,5,6);
    # the permutation as a product of transpositions
    my @prod = perm_to_trans(@perm);
    # a list to track how set permutes after each transposition
    my @list = ( [ @set ] );

    ## ARRAY REF PROBLEMS HERE!
    # apply each transposition to @set
    for my $i ( 0 .. $#prod-1) {
    my @tmpset = @list[$i];
    my @trans = ();
    push @trans,@prod[$i];
    push @trans,@prod[$i+1];
    my @newset = swap(@trans,@tmpset);
    say @newset;
    push @list,[ @newset ];
    }
}

# run the test
test();

## TODO ##
# check that cycle does not contain "illegal" characters
# param: the cycle to check
# returns: $flag
## TODO ##
sub is_valid_cycle {
    my @cycle = @_;
    my $flag = 0;
    return $flag;
}

## TODO ##
# check that each element in product is a transposition
# param: a product of cycles to check
# returns: $flag
## TODO ##
sub is_prod_trans {
    my $flag = 0;
    return $flag;
}

## TODO ##
# checks if a permutation is a product of disjoint cycles
# param: the permutation
# returns: $flag
## TODO ##
sub is_disjoint {
    my $flag = 0;
    return $flag;
}

## TODO ##
# checks if two permutations are equal
# param: permutations to check
# returns: $flag
## TODO ##
sub check_perms {
    my $flag = 0;
    return $flag;
}

## TODO ##
# main checker
# param: @correct_answer, @student_answer, @set, $check_disjoint, $check_trans
# returns: $flag
## TODO ##
sub checker {
    my $flag = 0;
    return $flag;
}

#EOF