This iterator is my 'naive' approach to producing 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.
#!/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 locatio
+n
[ reverse 0 .. $last ];
my @redo; # lists of indices already tried at each locat
+ion
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";
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|