File Coverage

File:blib/lib/Math/Permute/Array.pm
Coverage:100.0%

linestmtbrancondsubpodtimecode
1package Math::Permute::Array;
2
3
6
6
6
274249
9
167
use strict;
4
6
6
6
21
13
5765
use warnings;
5
6require Exporter;
7
8our @ISA = qw(Exporter);
9
10# Items to export into callers namespace by default. Note: do not export
11# names by default without a very good reason. Use EXPORT_OK instead.
12# Do not simply export all your public functions/methods/constants.
13
14# This allows declaration use Math::Permute::Array ':all';
15# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
16# will save memory.
17our %EXPORT_TAGS = ( 'all' => [ qw()],
18                     'Permute' => [ qw(Permute) ],
19                     'Apply_on_perms' => [ qw(Apply_on_perms) ]
20                   );
21
22our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
23
24our @EXPORT = qw(
25 Permute
26 Apply_on_perms
27);
28
29our $VERSION = '0.0421';
30
31
32sub new
33{
34
4
1
444926
  my $class = shift;
35
4
14
  my $self = {};
36
4
10
  $self->{array} = shift;
37
4
7
  $self->{iterator} = 0;
38
4
6
  $self->{cardinal} = undef;
39
4
33
  bless($self, $class);
40
4
24
  return undef unless (defined $self->{array});
41
3
22
  return $self;
42}
43
44#nice implementation from the cookbook
45#but mine seems lightly more efficient
46#sub N2Permute
47#{
48# my $rank = shift;
49# my $size = shift;
50# my @res;
51#
52# my $i=1;
53# while($i<=$size){
54# push @res, $rank % ($i);
55# $rank = int($rank / ($i));
56# $i++;
57# }
58# return @res;
59#}
60
61sub Permute
62{
63
80643
1
77673
  my $rest = shift;
64
80643
67399
  my $array = shift;
65
80643
405380
  return undef unless (defined $rest and defined $array);
66
80640
80640
66775
182789
  my @array = @{$array};
67
80640
86656
  my @res;
68
69# my $size = $#$array+1;
70# my @perm = N2Permute($k,$size);
71#push @res, splice(@array, (pop @perm), 1 )while @perm;
72
73
80640
70271
  my $i = 0;
74
80640
120932
  while($rest != 0){
75
506558
742141
    $res[$i] = splice @array, $rest % ($#array + 1), 1;
76
506558
561672
    $rest = int($rest / ($#array + 2));
77
506558
698586
    $i++;
78  }
79
80640
105564
  push @res, @array;
80
81
80640
676811
  return \@res;
82}
83
84sub permutation
85{
86
7
1
217
  my $self = shift;
87
7
8
  my $rest = shift;
88
7
17
  return undef unless (defined $rest);
89
6
6
7
19
  my @array = @{$self->{array}};
90
6
7
  my @res;
91
6
3
  my $i = 0;
92
6
11
  while($rest != 0){
93
8
16
    $res[$i] = splice @array, $rest % ($#array + 1), 1;
94
8
10
    $rest = int($rest / ($#array + 2));
95
8
15
    $i++;
96  }
97
6
7
  push @res, @array;
98
6
100
  return \@res;
99}
100
101sub Apply_on_perms(&@)
102{
103
4
1
150460
  my $func = shift;
104
4
4
  my $array = shift;
105
4
44
  return undef unless (defined $func and defined $array);
106
1
1
  my $rest;
107
1
1
  my $i;
108
1
1
  my $j;
109
1
1
1
3
  my @array = @{$array};
110
1
2
  my $size = $#array+1;
111
1
2
  my $card = factorial($size);
112
1
1
  my @res;
113  for($j=0;$j<$card;$j++){
114
40320
39305
    @res = ();
115
40320
33021
    $rest = $j;
116
40320
31398
    $i = 0;
117
40320
57935
    while($rest != 0){
118
253279
314229
      $res[$i] = splice @array, $rest % ($#array + 1), 1;
119
253279
274728
      $rest = int($rest / ($#array + 2));
120
253279
351172
      $i++;
121    }
122
40320
38548
    push @res, @array;
123
40320
264765
    &$func(@res);
124
40320
40320
1167044
137007
    @array = @{$array};
125
1
1
  }
126
1
9
  return 0;
127}
128
129sub cur
130{
131
2
1
65
  my $self = shift;
132
2
6
  return Math::Permute::Array::Permute($self->{iterator},$self->{array});
133}
134
135sub prev
136{
137
40320
1
1177760
  my $self = shift;
138
40320
75572
  return undef if($self->{iterator} == 0);
139
40319
35328
  $self->{iterator}--;
140
40319
61674
  return Math::Permute::Array::Permute($self->{iterator},$self->{array});
141}
142
143sub next
144{
145
40320
1
1166829
  my $self = shift;
146
40320
68646
  return undef if($self->{iterator} >= $self->cardinal() - 1);
147
40319
36528
  $self->{iterator}++;
148
40319
58381
  return Math::Permute::Array::Permute($self->{iterator},$self->{array});
149}
150
151sub cardinal
152{
153
40322
1
35869
  my $self = shift;
154
40322
70010
  unless(defined $self->{cardinal}){
155
2
2
3
14
    $self->{cardinal} = factorial($#{$self->{array}} + 1);
156  }
157
40322
87294
  return $self->{cardinal};
158}
159
160#this part come from:
161# www.theperlreview.com/SamplePages/ThePerlReview-v5i1.p23.pdf
162# Author: Alberto Manuel Simoes
163sub factorial
164{
165
3
1
5
    my $value = shift;
166
3
4
    my $res = 1;
167
3
9
    while ($value > 1) {
168
16
17
      $res *= $value;
169
16
21
      $value--;
170    }
171
3
6
    return $res;
172}
173
1741;
175