1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
#!/usr/bin/perl -w
# for your own pleasure and curiosity
use strict;
use blib;
use Algorithm::Permute 'permute';
use Benchmark ':all';
use Getopt::Std;
# process options
my %opts;
getopts('yrhl:n:', \%opts) or usage();
$opts{h} and usage();
$opts{n} ||= 9;
$opts{l} ||= 5;
my @arr = (1..$opts{n});
# runners
my %runners = (
'Combinatorial::Permutations' => sub {
my @res = Combinatorial::Permutations::permutate(@arr);
},
'Memoization' => sub {
my $num_permutations = PMemoization::factorial(scalar @arr);
for (my $i=0; $i < $num_permutations; $i++) {
my @permutation = @arr[PMemoization::n2perm($i, $#arr)];
# print "@permutation\n";
}
},
'LISPy' => sub { LISPy::faq_permute([@arr], []) },
'List::Permutor' => sub {
my $l = new List::Permutor(@arr);
while (my @res = $l->next) {}
},
'Algorithm::Permute' => sub {
my $p = new Algorithm::Permute([@arr]);
while (my @res = $p->next) {}
},
'Algorithm::Permute qw(permute)' => sub {
permute { my @res = @arr } @arr;
},
'Algorithm::Combinatorics' => sub {
my $i = Algorithm::Combinatorics::permutations(\@arr);
while (my $p = $i->next) {}
},
'Math::Combinatorics' => sub {
my $combinat = Math::Combinatorics->new(count => $opts{n}, data => \@arr);
while (my @res = $combinat->next_permutation) {}
},
);
my @modules;
# load optional modules
my @optionals =
qw/Algorithm::Combinatorics Math::Combinatorics List::Permutor/;
foreach my $m (@optionals) {
eval "require $m";
if ($@) {
print "Unable to load $m. Not yet installed?\n";
} else {
print "Module $m loaded.\n";
push @modules, $m;
}
}
# give user a chance to select modules to his/her interest
print "\nRun benchmark against:\n";
my @selected = grep {
print "$_ [Y/n]? ";
if ($opts{'y'}) { print "Y\n"; 1 }
else { my $ans = <>; $ans !~ /^N/i }
} @modules, qw/Combinatorial::Permutations Memoization LISPy/;
print "\n";
my $i = 0;
my %modules = map {
sprintf("%02d_", $i++) . $_ => $runners{$_}
} 'Algorithm::Permute qw(permute)', 'Algorithm::Permute', @selected;
# run benchmark
my $b = timethese($opts{l}, \%modules);
$opts{r} and do { print "\n"; cmpthese($b); };
sub usage {
print <<"USAGE";
$0 [options]
-h this help
-l number of loop (default: 5)
-n size of array (default: 9)
-r print benchmark comparison chart (default: no)
-y yes to all confirmation question (default: no)
Example:
Run permutation of 8 objects in 10 loop, and print comparison chart:
perl benchmark.pl -l 10 -n 8 -r
USAGE
exit;
}
package LISPy;
no strict;
no warnings;
sub faq_permute{
my @items = @{ $_[0] };
my @perms = @{ $_[1] };
unless (@items) {
# print "@perms\n";
@res = @perms;
} else {
my(@newitems,@newperms,$i);
foreach $i (0 .. $#items) {
@newitems = @items;
@newperms = @perms;
unshift(@newperms, splice(@newitems, $i, 1));
faq_permute([@newitems], [@newperms]);
}
}
}
package PMemoization; # permutation utilizing memoization
use strict;
# Utility function: factorial with memorizing
BEGIN {
no warnings;
my @fact = (1);
sub factorial($) {
my $n = shift;
return $fact[$n] if defined $fact[$n];
$fact[$n] = $n * factorial($n - 1);
}
}
# n2pat($N, $len) : produce the $N-th pattern of length $len
sub n2pat {
my $i = 1;
my $N = shift;
my $len = shift;
my @pat;
while ($i <= $len + 1) { # Should really be just while ($N) { ...
push @pat, $N % $i;
$N = int($N/$i);
$i++;
}
return @pat;
}
# pat2perm(@pat) : turn pattern returned by n2pat() into
# permutation of integers. XXX: splice is already O(N)
sub pat2perm {
my @pat = @_;
my @source = (0 .. $#pat);
my @perm;
push @perm, splice(@source, (pop @pat), 1) while @pat;
return @perm;
}
# n2perm($N, $len) : generate the Nth permutation of S objects
sub n2perm {
pat2perm(n2pat(@_));
}
package Combinatorial::Permutations; # from abigail
use strict;
use Exporter;
use vars qw /@EXPORT @EXPORT_OK @ISA/;
@ISA = qw /Exporter/;
@EXPORT = ();
@EXPORT_OK = qw /permutate/;
sub permutate (@);
# Return a list of permutations of the given list.
sub permutate (@) {
return () unless @_;
my $first = shift;
return ([$first]) unless @_;
map {my $row = $_;
map {my $tmp = [@$row];
splice @$tmp, $_, 0, $first; $tmp;} (0 .. @$row);} permutate @_;
}
|
