File Coverage

blib/lib/Math/Permute/Array.pm

Criterion	Covered	Total	%
statement	83	84	98.8
branch	14	14	100.0
condition	6	6	100.0
subroutine	11	11	100.0
pod	9	9	100.0
total	123	124	99.1

package Math::Permute::Array;

use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Math::Permute::Array ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw()],
                     'Permute' => [ qw(Permute) ],
                     'Apply_on_perms' => [ qw(Apply_on_perms) ]
                   );

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

our @EXPORT = qw(
 Permute
 Apply_on_perms
);

our $VERSION = '0.043';


sub new
{
  my $class = shift;
  my $self = {};
  $self->{array}    = shift;
  $self->{iterator} = 0;
  $self->{cardinal} = undef;
  bless($self, $class);
  return undef unless (defined $self->{array});
  return $self;
}

#nice implementation from the cookbook
#but mine seems lightly more efficient
#sub N2Permute
#{
#  my $rank = shift;
#  my $size = shift;
#  my @res;
#
#  my $i=1;
#  while($i<=$size){
#    push @res, $rank % ($i);
#    $rank = int($rank / ($i));
#    $i++;
#  }
#  return @res;
#}

sub Permute
{
  my $rest = shift;
  my $array = shift;
  return undef unless (defined $rest and defined $array);
  my @array = @{$array};
  my @res;

#  my $size = $#$array+1;
# my @perm = N2Permute($k,$size);
#push @res, splice(@array, (pop @perm), 1 )while @perm;

  my $i = 0;
  while($rest != 0){
    $res[$i] = splice @array, $rest % ($#array + 1), 1;
    $rest = int($rest / ($#array + 2));
    $i++;
  }
  push @res, @array;

  return \@res;
}

sub permutation
{
  my $self = shift;
  my $rest = shift;
  return undef unless (defined $rest);
  my @array = @{$self->{array}};
  my @res;
  my $i = 0;
  while($rest != 0){
    $res[$i] = splice @array, $rest % ($#array + 1), 1;
    $rest = int($rest / ($#array + 2));
    $i++;
  }
  push @res, @array;
  return \@res;
}

sub Apply_on_perms(&@)
{
  my $func = shift;
  my $array = shift;
  return undef unless (defined $func and defined $array);
  my $rest;
  my $i;
  my $j;
  my @array = @{$array};
  my $size = $#array+1;
  my $card = factorial($size);
  my @res;
  for($j=0;$j<$card;$j++){
    @res = ();
    $rest = $j;
    $i = 0;
    while($rest != 0){
      $res[$i] = splice @array, $rest % ($#array + 1), 1;
      $rest = int($rest / ($#array + 2));
      $i++;
    }
    push @res, @array;
    &$func(@res);
    @array = @{$array};
  }
  return 0;
}

sub cur
{
  my $self = shift;
  return Math::Permute::Array::Permute($self->{iterator},$self->{array});
}

sub prev
{
  my $self = shift;
  return undef if($self->{iterator} == 0);
  $self->{iterator}--;
  return Math::Permute::Array::Permute($self->{iterator},$self->{array});
}

sub next
{
  my $self = shift;
  return undef if($self->{iterator} >= $self->cardinal() - 1);
  $self->{iterator}++;
  return Math::Permute::Array::Permute($self->{iterator},$self->{array});
}

sub cardinal
{
  my $self = shift;
  unless(defined $self->{cardinal}){
    $self->{cardinal} = factorial($#{$self->{array}} + 1);
  }
  return $self->{cardinal};
}

#this part come from:
# www.theperlreview.com/SamplePages/ThePerlReview-v5i1.p23.pdf
# Author: Alberto Manuel Simoes
sub factorial
{
    my $value = shift;
    my $res = 1;
    while ($value > 1) {
      $res *= $value;
      $value--;
    }
    return $res;
}

1;

__END__