note
ady
Hi,<br><br>
If your problem is generating the <b>alfabetic permutation</b> for the filenames, that's not quite trivial. You can find a good discussion in the book <a href="http://hop.perl.plover.com">Higher-Order Perl</a> by <I>Mark Jason Dominus</i>.<br><br>
Here's some (slightly adapted) code snippets from the book, that you may find useful :<br>
<readmore>
<code>
#!/usr/bin/perl -w
use strict;
sub Iterator (&) { return $_[0] }
sub NEXTVAL { $_[0]->() }
### ==================================================================
### permute (HOP1, 3.1)
### ==================================================================
sub permute {
my @items = @{ $_[0] };
my @perms = @{ $_[1] };
my $fun = $_[2] || sub { print "\t@{$_[0]}\n"; };
unless (@items) {
$fun->(\@perms);
} else {
my (@newitems, @newperms, $i);
foreach $i (0 .. $#items) {
@newitems = @items;
@newperms = @perms;
# Remove #i item and prepend to perms; Permute new lists.
unshift(@newperms, splice(@newitems, $i, 1));
permute([@newitems], [@newperms], $fun);
}
}
}
### ==================================================================
### permute2 (HOP1 4,3.1)
### ==================================================================
sub permute2 {
my @items = @_;
my @pattern = (0) x @items;
return Iterator {
return unless @pattern;
my @result = pattern_to_permutation(\@pattern, \@items);
@pattern = increment_pattern(@pattern);
return @result;
};
}
sub increment_pattern {
my @odometer = @_;
my $wheel = $#odometer; # start at rightmost wheel
until ($odometer[$wheel] < $#odometer-$wheel || $wheel < 0) {
$odometer[$wheel] = 0;
$wheel--; # next wheel to the left
}
if ($wheel < 0) {
return; # fell off the left end; no more sequences
} else {
$odometer[$wheel]++; # this wheel now turns one notch
return @odometer;
}
}
sub pattern_to_permutation {
my $pattern = shift;
my @items = @{shift()};
my @r;
for (@$pattern) {
push @r, splice(@items, $_, 1);
}
@r;
}
### ==================================================================
### permute_n (HOP1 4,3.1)
### ==================================================================
sub permute_n {
my @items = @_;
my $n = 0;
return Iterator {
my @pattern = n_to_pat($n, scalar(@items));
my @result = pattern_to_permutation(\@pattern, \@items);
$n++;
return @result;
};
}
sub n_to_pat {
my @odometer;
my ($n, $length) = @_;
for my $i (1 .. $length) {
unshift @odometer, $n % $i;
$n = int($n/$i);
}
return $n ? () : @odometer;
}
### ==================================================================
### permute-flop (HOP1 4,3.1)
### ==================================================================
sub permute_flop {
my @items = @_;
my $n = 0;
return Iterator {
$n++, return @items if $n==0;
my $i;
my $p = $n;
for ($i=1; $i<=@items && $p%$i==0; $i++) {
$p /= $i;
}
my $d = $p % $i;
my $j = @items - $i;
return if $j < 0;
@items[$j+1..$#items] = reverse @items[$j+1..$#items];
@items[$j,$j+$d] = @items[$j+$d,$j];
$n++;
return @items;
};
}
=cut
### -------------------------------------------------------
print "permute \n " . "-" x 40 . "\n";
my @col = [qw(white red orange yellow green blue violet black)];
my @res = [];
my $start = time();
#permute(@col, []);
permute(@col, [], sub { push @res, $_[0]; });
# print "@res\n"; #print Dumper( \@res );
print time() - $start . " sec.\n";
=cut
### -------------------------------------------------------
print "increment_pattern \n " . "-" x 40 . "\n";
my @items = ('A' .. 'D');
my @pattern = (0) x @items;
while (@pattern = increment_pattern(@pattern) ) {
print "@pattern\n";
#print Dumper( \@pattern );
}
print "\npermute2 \n " . "-" x 40 . "\n";
my $pit = permute2('A' .. 'D');
while (my @p = NEXTVAL($pit)) {
print "@p\n";
}
$pit = permute2( qw(red orange yellow green blue violet) );
while (my @p = NEXTVAL($pit)) {
print "@p\n";
}
### -------------------------------------------------------
print "permute_n \n " . "-" x 40 . "\n";
my $it_n = permute_n('A' .. 'D');
while (my @p = NEXTVAL($it_n)) {
print "@p\n";
}
### -------------------------------------------------------
print "permute_flop \n " . "-" x 40 . "\n";
my $it_f = permute_flop('A' .. 'D');
while (my @p = NEXTVAL($it_f)) {
print "@p\n";
}
</code>
</readmore>
<br><br>
Best regards,<br>
<i>Allan Dystrup</i>
675858
675858