File Coverage

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


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