CUFP
tye
<p>
This iterator is my 'naive' approach to producing [google://derangements] via an iterator (at [japhy]'s prompting so he can produce his "Secret Santa" lists). A derangement is a permutation where none of the elements remained in their starting positions.
</p><code>
#!/usr/bin/perl -w
use strict;
sub derange
{
my @set= @_; # items (strings) to be deranged
my $last= $#set; # last index into our list
my @stack= # lists of indices to be tried at each location
[ reverse 0 .. $last ];
my @redo; # lists of indices already tried at each location
my @ret; # offsets to each selected item
my $i= 0; # which slot we are trying to fill
my $left= $stack[$i]; # indices to consider for the current slot
return sub {
while( 1 ) {
do {
if( ! @$left ) {
return if --$i < 0;
$left= $stack[$i];
push @{$redo[$i]}, $ret[$i];
}
if( @$left && $i == $left->[-1] ) {
# skip this index as it'd not make a derangement
push @{$redo[$i]}, pop @$left;
}
} while( ! @$left );
$ret[$i]= pop @$left;
if( $i == $last ) {
return @set[@ret];
}
$left= [ @$left, @{$redo[$i]} ];
$redo[++$i]= [];
$stack[$i]= $left;
}
};
}
@ARGV= 1..5 if ! @ARGV;
my $iter= derange( @ARGV );
my @list;
while( @list= $iter->() ) {
print "@list\n";
}
</code>
<div class="pmsig"><div class="pmsig-22609"><p align="right">
- [tye]<tt> </tt>
</p></div></div>