Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

Re^4: Derangements iterator (order)

by tye (Sage)
on Jan 02, 2006 at 20:42 UTC ( #520452=note: print w/replies, xml ) Need Help??

in reply to Re^3: Derangements iterator (others)
in thread Derangements iterator

Thanks for the explanation.

The current interface guarantees lexicographic order

It is easy to adjust my iterator to get lexicographic order. For example, just add one reverse:

$left= [ @$left, reverse @{$redo[$i]} ];

I plan to add a version to Algorithm::Loops before I die. (:

- tye        

Replies are listed 'Best First'.
Re^5: Derangements iterator (NestedLoops implementation)
by Roy Johnson (Monsignor) on Jan 04, 2006 at 16:57 UTC
    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://520452]
[choroba]: stop making chessy jokes about bishops!
[choroba]: I mean cheesy
[LanX]: lol
[ambrus]: no, the chess bishop itself is a joke on real bi-shops
[ambrus]: or at least on the stereotype of bi-shops
[choroba]: we call chess bishops "archers"
[Eily]: choroba sorry, I had to get that off my chess
[ambrus]: chess certainly hasn't started those stereotypes, like how kings aren't that powerful but has convinced their whole country to work for them, etc. it's just poured them to a nice clean form that would easily get propagated.

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (13)
As of 2017-09-26 12:19 GMT
Find Nodes?
    Voting Booth?
    During the recent solar eclipse, I:

    Results (294 votes). Check out past polls.