Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

Re^5: Derangements iterator (NestedLoops implementation)

by Roy Johnson (Monsignor)
on Jan 04, 2006 at 16:57 UTC ( #520953=note: print w/replies, xml ) Need Help??

in reply to Re^4: Derangements iterator (order)
in thread Derangements iterator

Here's a version you can add to Algorithm::Loops. It uses NestedLoops and is comparatively efficient about skipping invalid combinations. It also puts its results in numeric/lexicographic order and handles duplicates. The commented-out code is for watching/debugging the management of the "pool" of available numbers.
use strict; use warnings; use Algorithm::Loops 'NestedLoops'; sub derange { # Generate the list of possible values at each position # Skip a value if it's already used up (no more in the pool) or is i +n its original position my %pool; ++$pool{$_} for (@_); my @orig = @_; no warnings 'numeric'; my @values = sort {$a <=> $b or $a cmp $b} keys %pool; my @prev_values; NestedLoops( [(sub { # Generate all candidate values for this position # print "Generating with \@_ = @_\n"; my $pos = @_; # Update the pool: the last value on @_ has just changed, so # return the previous value(s) to the pool and remove the new # one. if (@_) { for (grep {defined $prev_values[$_]} $#_..$#orig-1) { #print "Returning $prev_values[$_] to the pool\n"; ++$pool{$prev_values[$_]}; undef $prev_values[$_]; } #print "Removing $_[-1] from the pool\n"; --$pool{$_[-1]}; #print "Valid values in the pool:\n"; #while (my ($k,$v) = each %pool) { # print "$k: $v\n" if $v; #} $prev_values[$#_] = $_[-1]; } [ grep {$orig[$pos] ne $_ and $pool{$_} > 0} @values ] }) x @orig] ); } my @results; my $iter = derange(@ARGV); print "@results\n" while @results = $iter->();
As a possibly interesting note: if you simply remove $orig[$pos] ne $_ and, it becomes a permutations generator. But derange is not simply a permutations generator that filters out individual invalid permutations; it prunes entire sub-trees. (Similarly, the permutation generator doesn't loop through the whole cartesian space and filter it.)

Caution: Contents may have been coded under pressure.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://520953]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (8)
As of 2017-04-25 18:44 GMT
Find Nodes?
    Voting Booth?
    I'm a fool:

    Results (462 votes). Check out past polls.