Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Re^3: Derangements iterator (others)

by fxn (Sexton)
on Jan 02, 2006 at 14:56 UTC ( #520401=note: print w/replies, xml ) Need Help??

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

(Re: Algorithm::Combinatorics) the logic in principle can be refined to skip some more permutations, but benchmarks showed no difference whatsoever, so I left the code that is easier to understand and added a comment about it:

    /* I tried an alternative approach that would in theory avoid the
    generation of some permutations with fixed-points: keeping track of
    the leftmost fixed-point, and reversing the elements to its right.
    But benchmarks up to n = 11 showed no difference whatsoever.
    Thus, I left this version, which is simpler.

    That n = 11 does not mean there was a difference for n = 12, it
    means I stopped benchmarking at n = 11. */

The current interface guarantees lexicographic order, but I plan to provide more algorithms that relax that condition if you don't need it and faster generators are available. I will write it before I die ideally.

Replies are listed 'Best First'.
Re^4: Derangements iterator (order)
by tye (Sage) on Jan 02, 2006 at 20:42 UTC

    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        

      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://520401]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (6)
As of 2018-03-21 10:02 GMT
Find Nodes?
    Voting Booth?
    When I think of a mole I think of:

    Results (265 votes). Check out past polls.