File Coverage

blib/lib/Math/Permute/List.pm
Criterion Covered Total %
statement 27 27 100.0
branch 4 4 100.0
condition n/a
subroutine 4 4 100.0
pod 0 1 0.0
total 35 36 97.2


line stmt bran cond sub pod time code
1             =head1 Name
2            
3             Math::Permute::List - Generate all permutations of a list.
4            
5             =head1 Synopsis
6            
7             use Math::Permute::List;
8            
9             permute {say "@_"} qw(a b c);
10            
11             # a b c
12             # a c b
13             # b a c
14             # c a b
15             # b c a
16             # c b a
17            
18             =cut
19            
20 10     10   175472 use strict;
  10         19  
  10         2235  
21            
22             package Math::Permute::List;
23            
24 10     10 0 133 sub permute(&@)
25             {my $s = shift; # Subroutine to call to process each permutation
26            
27 10         23 my $n = scalar(@_); # Size of array to be permuted
28             # return 0 unless $n; # Empty lists cannot be permuted - removed per Philipp Rumpf
29 10         22 my $l = 0; # Item being permuted
30 10         25 my @p = (); # Current permutations
31 10         24 my @P = @_; # Array to permute
32 10         17 my @Q = (); # Permuted array
33            
34 10         17 my $p; $p = sub # Generate each permutation
  9864541         7547280  
35 9864551 100   9864551   10591678 {if ($l < $n)
36 6235584         6195612 {for(0..$n-1)
  3628967         4606877  
37 62354304 100       87030562 {if (!$p[$_])
38             {$Q[$_] = $P[$l];
39 9864541         7016663 $p[$_] = ++$l;
40 9864541         9470144 &$p();
41 9864539         10520998 --$l;
42 9864539         9347343 $p[$_] = 0;
43             }
44             }
45             }
46             else
47             {&$s(@Q);
48             }
49 10         51 };
50            
51 10         37 &$p;
52            
53 9         18 my $i = 1; $i *= $_ for 2..$n;
  9         39  
54 9         72 $i # Number of permutations
55             }
56            
57             # Export details
58            
59             require 5;
60             require Exporter;
61            
62 10     10   55 use vars qw(@ISA @EXPORT $VERSION);
  10         22  
  10         1013  
63            
64             @ISA = qw(Exporter);
65             @EXPORT = qw(permute);
66             $VERSION = '1.005';
67            
68             =head1 Description
69            
70             Generate and process all the all the permutations of a list using the
71             standard Perl metaphor.
72            
73             C returns the number of permutations in both scalar and array
74             context.
75            
76             C is easy to use and fast. It is written in 100% Pure Perl.
77            
78             Please note that the order in which the permutations are generated is
79             not guaranteed, so please do not rely on it.
80            
81             =head1 Export
82            
83             The C function is exported.
84            
85             =head1 Installation
86            
87             Standard Module::Build process for building and installing modules:
88            
89             perl Build.PL
90             ./Build
91             ./Build test
92             ./Build install
93            
94             Or, if you're on a platform (like DOS or Windows) that doesn't require
95             the "./" notation, you can do this:
96            
97             perl Build.PL
98             Build
99             Build test
100             Build install
101            
102             =head1 Author
103            
104             PhilipRBrenan@appaapps.com
105            
106             http://www.appaapps.com
107            
108             =head1 See Also
109            
110             =over
111            
112             =item L
113            
114             =item L
115            
116             =item L
117            
118             =item L
119            
120             =item L
121            
122             =back
123            
124             =head1 Copyright
125            
126             Copyright (c) 2009 Philip R Brenan.
127            
128             This module is free software. It may be used, redistributed and/or
129             modified under the same terms as Perl itself.
130            
131             =cut