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

Re^2: Derangements iterator (others)

by tye (Cardinal)
on Dec 31, 2005 at 19:44 UTC ( #520184=note: print w/ replies, xml ) Need Help??


in reply to Re: Derangements iterator
in thread Derangements iterator

japhy claimed to have looked at several implementations but been disappointed with each of them. I think he said that each was either too esoteric for him to understand easily enough or did too much work generating permutations that had to be skipped.

I felt that I had a rather straight-forward approach that wouldn't backtrack much at all. It is very much like Algorithm::Loops::NestedLoops(), except I attempt to build the list of values to loop over next (the offsets not currently selected) more efficiently by keeping track as I go. But I think I can do this more efficiently still.

So the code just moves along selecting the next item (actually its offset) from the list of items not selected earlier in the list and not at the same offset (and not previously selected for this slot during the current 'round').

This approach occasionally has to 'backtrack', but (I believe) this only happen when it gets to the last slot and does that at most once per derangement returned. So trying to look ahead to prevent this tiny amount of backtracking would actually be slower than the 'naive' approach.

I looked at the code for Algorithm::Combinatorics and saw that it was using the lexical-order permutation algorithm1 modified to try to skip non-derangements somewhat efficiently. I had rejected this approach as a first choice because it contains a step where you reverse a part of your list and that can place one or more items back into their original positions in such a way that it would be tricky to quickly jump to the next permutation that is a derangement. And the comments implied that it did have to skip many permutations because of this.

So, based on japhy's assessment I didn't look at other implementations. Thanks for pointing those out.

1 The classical lexical-order permutation algorithm is very similar to Algorithm::Loops::NextPermute() except for not dealing with duplicate values, something that I have yet to see done outside of my Algorithm::Loops.

- tye        


Comment on Re^2: Derangements iterator (others)
Re^3: Derangements iterator (others)
by fxn (Sexton) on Jan 02, 2006 at 14:56 UTC

    (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.

      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?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://520184]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2014-09-18 04:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (108 votes), past polls