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)

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

Create A New User
Node Status?
node history
Node Type: note [id://520401]
help
Chatterbox?
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
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
When I think of a mole I think of:

Results (265 votes). Check out past polls.

Notices?