http://qs321.pair.com?node_id=151248


in reply to Permuting with duplicates and no memory

If you want a nice numeric permutation iterator-making closure (as I did), here's how I'd write it (based completely on the above node).
sub make_orderings { my $num = shift; my @arr = (1 .. $num); return sub { my $last = $#arr; my $i = $last - 1; $i-- while 0 <= $i && $arr[$i] >= $arr[$i+1]; return if $i == -1; @arr[$i+1..$last] = reverse @arr[$i+1..$last] if $arr[$i+1] > $arr[$last]; my $j=$i+1; $j++ while $arr[$i] >= $arr[$j]; @arr[$i,$j] = @arr[$j,$i]; return @arr; } }

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

Replies are listed 'Best First'.
Re^2: Permuting with duplicates and no memory
by jettero (Monsignor) on Apr 01, 2007 at 15:01 UTC

    I borrowed this for something and noticed that if $num=8 this produces only 40319 permutations... I made the following el cheapo minor modification on mine.

    sub make_orderings { my $num = shift; my @arr = (1 .. $num); my $first = 1; return sub { if( $first ) { $first = 0; return @arr; } my $last = $#arr; my $i = $last - 1; $i-- while 0 <= $i && $arr[$i] >= $arr[$i+1]; return if $i == -1; @arr[$i+1..$last] = reverse @arr[$i+1..$last] if $arr[$i+1] > $arr[$last]; my $j=$i+1; $j++ while $arr[$i] >= $arr[$j]; @arr[$i,$j] = @arr[$j,$i]; return @arr; } }

    -Paul

      Just FYI, perhaps you missed this bit from the root node:

      do { print "@ARGV\n"; } while( nextPermut­e(@ARGV) );

      which is also why I called my routine "nextPermute".

      Also note that dragonchild's and my iterators can be reused. For yours to be reusable you probably want to change:

      return if $i == -1;

      to

      if( $i == -1 ) { $first= 1; return; }

      - tye