"The derangements of @data are those reorderings that have no element in its original place. In jargon those are the permutations of @data with no fixed points."

dragonchild,
Sure List::Util has shuffle() but how does this meet the requirement. Perhaps I am misreading it or perhaps the root thread was updated after you replied but I believe the requirement also mandates that elements not remain in their original position. This is a derangement and I think that Derangement of a list and Derangements iterator are probably more applicable. I also see that frenchtoast had the same idea elsewhere in the thread.

Cheers - L~R

So on average, for large n, 3 shuffles should suffice?

-QM
--
Quantum Mechanics: The dreams stuff is made of

Said brute-force solution would fall in the category of bogoshuffle...   :P

Reading the whole WP entry, you might try a bozo-shuffle -- if it's not shuffled, swap the current item for an item later in the list, then back up 1 position (as the just swapped in item might sort before the previous item).

(This seems to devolve into a bubblesort in reverse, well, sorta.)

-QM
--
Quantum Mechanics: The dreams stuff is made of

sub shuffler{
    foreach (@_){ 
        do{$r = int(rand($#_+1)); }while ((($r == $c) ||($temp[$r])));
        $temp[$r]= $_;$c++;
    }
    return @temp;
}
[download]

Thatll do it for you for a 1 dimensional array

hope it is what you were looking for

Edited by planetscape - added code tags

That doesn't seem to work well either. It sometimes goes to an infinite loop.

use strict;
use warnings;

my @array = (1..9);

sub derange {
  use List::Util 'shuffle';
  my @list = shuffle @_;
  my %map = map {($list[$_-1] => $list[$_])} 0..$#list;
  print "@map{@_}\n";
}

print "@array\n";
derange(@array) for 1..15;
[download]

One slightly non-obvious thing I did was to use negative indexing so that my mapping would wrap around from the last element to the first.

That works well for 3 elements, but for 4, there are some derangements it never generates, for example (2, 1, 4, 3).

An astute observation. For those who wonder why, it's because the mapping required to produce 2 1 4 3 is 1 => 2, 2 => 1, 3 => 4, 4 => 3, and my mapping is a big cycle. If I get a bit of time to work on it, I'll post some updated code that allows for subcycles.

Update (again: previous code that appeared here was broken): If you modify the Fisher-Yates algorithm to force every element to swap with a higher element (instead of possibly "swapping" with itself), then almost all derangements are possible; all derangements become possible (thought not equally likely) if you use a random position in the list as the first location to swap from, and allow some swaps to be skipped if the candidates are already deranged.

use strict;
use warnings;

sub derange {
  my @list = @_;
  # Swap every element with something higher
  my $start = int rand @list;
  for (0..($#list-1)) {
    my $this = ($start + $_) % @_;
    next if $list[$this] ne $_[$this] and $_ < $#list-1 and rand > .52
+;
    my $other = $_ + 1 + int rand($#list - $_);
    $other = ($start + $other) % @_;
    @list[$this,$other] = @list[$other,$this];
  }
  "@list";
}

my @ar = ('a'..'d');
print "@ar\n";
my %countem;
$countem{derange @ar}++ for 1..5000;
print "$_: $countem{$_}\n" for (sort keys %countem);
[download]

---

Caution: Contents may have been coded under pressure.

Are you saying that *none* of the elements can be in the same position as the original array? If so, then I suppose you'd have to compare the two arrays after the shuffle, and reject the shuffle if you found any two elements equal.

BTW, is this by any chance a homework problem?

It is, and I am/was having a lot of trouble determining a solution to the given problem. Part of the problem is that I am relatively new to perl, and its been a while since I last programmed in Java, so I am quite rusty. However, I would not have just copied and pasted any code and put it off as my own either. More looking for some pseudo code/algorithm to accomplish this.

OK, then how about this:

1. Take your array, and make a copy.
2. Shuffle one of them.
3. Compare the elements of the arrays.
4. If you find a match, then go back to step 2.
5. If not, then quit - you've found a unique shuffling.

I have to admit that this is a fairly simple-minded approach, but consider the source ;-). I don't doubt that there is a Perlish way of doing it - there always is. But I don't know it, yet.

Here's another mechanism for you:

1. Make a copy of your array
2. shuffle it (using List::Util::shuffle)
3. do an element-wise comparison of your two arrays and if you find a match swap that element with an adjacent element
4. goto 3 until you swap no more

duff

You could shuffle the array normally and check that no element remains in its place, and I think that wouldn't be so inefficent either, as IIRC the probability that no element remains in its place is 1/e, so this would require only 3 shufflings on average.

I've run your code a few times for the array (1, 2, 3), and it seems that it always returns (3, 2, 1), while it should return (2, 3, 1) or (3, 1, 2) so I think it doesn't do what you want.

It gives similarly wrong results for the array (1, 2, 3, 4) and gets in an infinite loop for (1, 2).

perl -e "my @toshuffle = qw (a b c d e f g h);$rand{$_}=1 for @toshuff
+le;print keys %rand;"

##OR in a sub-way


sub shuffle_array{
my @ar = @_;
my %rand;
$rand{$_} = undef for @ar;
my @ret = keys %rand;
return @ret;
}
[download]

From perlsec:

Also note that while the order of the hash elements might be randomised, this "pseudoordering" should not be used for applications like shuffling a list randomly (use List::Util::shuffle() for that, see List::Util, a standard core module since Perl 5.8.0; or the CPAN module Algorithm::Numerical::Shuffle), or for generating permutations (use e.g. the CPAN modules Algorithm::Permute or Algorithm::FastPermute), or for any cryptographic applications.

And indeed, your subroutine returns the same order if you call it twice for the same array in the same perl instance.

Your code doesn't guarantee that no elements get to their place.

If you don't have the criterion that no elements get into their place, I see no reason to use this stupid way instead of one of the simpler ways:

1. use List::Util "shuffle";
   sub shuffleArray{   
           shuffle(@_);
   }
   [download]

2. sub shuffleArray{
           my @p = @_;
           my $k;
           $k = $_ + int(rand(@p - $_)),      
                   @p[$_, $k] = @p[$k, $_] for
                   0 .. @p - 1;
           @p;
   }
   [download]

3. sub shuffleArray{
           my @p = @_;
           map { splice @p, $_ + rand(@p - $_), 1, $p[$_] } 0 .. @p - 1;
   }
   [download]

4. sub shuffleArray{
           my @p = @_;
           my $t;
           map { $t = splice @p, rand(@p), 1, $p[0]; shift @p; $t } 0 .. 
   +@p - 1;
   }
   [download]

5. sub shuffleArray{
           my @w = map { rand } @_; 
           @_[sort { $w[$a] <=> $w[$b] } 0 .. @_ - 1];
   }
   [download]

6. sub shuffleArray{
           map { $$_[1] } sort { $$a[0] <=> $$b[0] } map { [rand, $_] } @
   +_;
   }
   [download]

7. sub shuffleArray{
           map { $$_[0] } sort { ref $a <=> ref $b } map { bless [$_], ra
   +nd } @_;      
   }
   [download]