File Coverage

blib/lib/Math/Disarrange/List.pm
Criterion Covered Total %
statement 29 29 100.0
branch 8 8 100.0
condition n/a
subroutine 4 4 100.0
pod 0 1 0.0
total 41 42 97.6


line stmt bran cond sub pod time code
1             =head1 Name
2              
3             Math::Disarrange::List - Generate all disarrangements of a list.
4              
5             =head1 Synopsis
6              
7             use Math::Disarrange::List;
8              
9             disarrange {say "@_"} qw(a b c);
10              
11             # c a b
12             # b c a
13              
14             =cut
15              
16 10     10   280455 use strict;
  10         25  
  10         11913  
17              
18             package Math::Disarrange::List;
19              
20 10     10 0 134 sub disarrange(&@)
21             {my $s = shift; # Subroutine to call to process each disarrangement
22              
23 10         26 my $n = scalar(@_); # Size of array to be disarranged
24 10 100       55 return 0 if $n < 2; # Require at least two elements to disarrange
25 8         18 my $m = 0; # Number of disarrangements
26 8         19 my $l = 0; # Item being disarranged
27 8         19 my @p = (); # Current disarrangements
28 8         25 my @P = @_; # Array to disarrange
29 8         18 my @Q = (); # Disarranged array
30              
31 8 100       14 my $p; $p = sub # Generate each disarrangement
  26778164         43901478  
32 4012919 100   4012919   5958419 {if ($l < $n)
33 2677897         4132316 {for(0..$n-1)
  1335022         2784431  
34             {next if $l == $_;
35 24100268 100       42409472 if (!$p[$_])
  4012911         4620336  
36             {$Q[$_] = $P[$l];
37 4012911         4251708 $p[$_] = ++$l;
38 4012911         6278915 &$p();
39 4012909         4323887 --$l;
40 4012909         5512700 $p[$_] = 0;
41             }
42             }
43             }
44             else
45 1335021         3216955 {&$s(@Q); ++$m;
46             }
47 8         40 };
48              
49 8         31 &$p;
50              
51 7         67 $m
52             }
53              
54             # Export details
55            
56             require 5;
57             require Exporter;
58              
59 10     10   73 use vars qw(@ISA @EXPORT $VERSION);
  10         19  
  10         1364  
60              
61             @ISA = qw(Exporter);
62             @EXPORT = qw(disarrange);
63             $VERSION = '1.004'; # Saturday 21 March 2009
64              
65             =head1 Description
66              
67             Generate and process all the all the disarrangements of a list using the
68             standard Perl metaphor. A disarrangement is a permutation of the
69             original list in which no element is in its original position.
70              
71             C returns the number of disarrangements in both scalar and
72             array context.
73              
74             C is easy to use and fast. It is written in 100% Pure
75             Perl.
76              
77             Please note that the order in which the disarrangements are generated is
78             not guaranteed, so please do not rely on it.
79              
80             =head1 Export
81              
82             The C function is exported.
83              
84             =head1 Installation
85              
86             Standard Module::Build process for building and installing modules:
87              
88             perl Build.PL
89             ./Build
90             ./Build test
91             ./Build install
92              
93             Or, if you're on a platform (like DOS or Windows) that doesn't require
94             the "./" notation, you can do this:
95              
96             perl Build.PL
97             Build
98             Build test
99             Build install
100              
101             =head1 Author
102              
103             PhilipRBrenan@handybackup.com
104              
105             http://www.handybackup.com
106              
107             =head1 See Also
108              
109             =over
110              
111             =item L
112              
113             =item L
114              
115             =item L
116              
117             =back
118              
119             =head1 Copyright
120              
121             Copyright (c) 2009 Philip R Brenan.
122              
123             This module is free software. It may be used, redistributed and/or
124             modified under the same terms as Perl itself.
125              
126             =cut