Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

Array Shuffle

by dunno260 (Novice)
on Feb 28, 2006 at 02:46 UTC ( [id://533228]=perlquestion: print w/replies, xml ) Need Help??

dunno260 has asked for the wisdom of the Perl Monks concerning the following question:

I need to write a subroutine that takes an array and shuffles it, however it has to ensure that the values in the new array are not in their original position. I came up with the following code and it appears to do what I want, though I am not completely sure yet. For whatever reason, the for loop doesn't work on the last element, so I just handle it outside the loop.
sub shuffleArray { my @array = @_; my $length = @array; for(my $i = 0; $i < $length - 1; $i++) { my $random = int rand($length -1); if ($i eq $random){$i--;} else{@array[$i,$random] = @array[$random, $i];} } my $random = int rand($length -2); @array[$random,$length -1] = @array[$length -1,$random]; return @array; }

Replies are listed 'Best First'.
Re: Array Shuffle
by frenchtoast (Acolyte) on Feb 28, 2006 at 03:24 UTC
    see Algorithm::Combinatorics::derangements(\@data)

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

Re: Array Shuffle
by dragonchild (Archbishop) on Feb 28, 2006 at 02:48 UTC
    List::Util has shuffle().

    My criteria for good software:
    1. Does it work?
    2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
      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

Re: Array Shuffle
by Thelonius (Priest) on Feb 28, 2006 at 03:19 UTC
    I don't have a solution to this, but an interesting bit of mathematical trivia is that if you shuffle at random the odds that none of the elements ends up in the original space approaches 1/e as n -> infinity.
      So on average, for large n, 3 shuffles should suffice?

      Quantum Mechanics: The dreams stuff is made of

Re: Array Shuffle
by friedo (Prior) on Feb 28, 2006 at 02:55 UTC
    List::Util's shuffle is good, but it's totally random, so it doesn't guarantee anything about the position of the shuffled elements. A brute-force solution would be to shuffle repeatedly until you end up with a satisfactory order, but that really sucks.

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

        Quantum Mechanics: The dreams stuff is made of

Re: Array Shuffle
by zer (Deacon) on Feb 28, 2006 at 04:45 UTC
    sub shuffler{ foreach (@_){ do{$r = int(rand($#_+1)); }while ((($r == $c) ||($temp[$r]))); $temp[$r]= $_;$c++; } return @temp; }

    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.

Re: Array Shuffle
by phaylon (Curate) on Feb 28, 2006 at 02:50 UTC
    IIRC there's a shuffle method in Scalar-List-Utils' List::Util, though I don't know if it guarantees that they're in a different order afterwards.

    Ordinary morality is for ordinary people. -- Aleister Crowley
Re: Array Shuffle
by Roy Johnson (Monsignor) on Feb 28, 2006 at 15:34 UTC
    A derangement is just a mapping from every element of a set to some other element of the set. The simplest derangement is to map each element to its neighbor. And if you randomize the list before doing that mapping, you have a random derangement (mapping). You can then use that mapping on the original list to get a derangement of the original list.
    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;
    You'll see that in the output, no element appears in its original position (after the first line, which is there for reference).

    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.

    Caution: Contents may have been coded under pressure.

      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);

        Caution: Contents may have been coded under pressure.
Re: Array Shuffle
by spiritway (Vicar) on Feb 28, 2006 at 04:34 UTC

    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
Re: Array Shuffle
by ambrus (Abbot) on Feb 28, 2006 at 12:18 UTC

    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.

Re: Array Shuffle
by ambrus (Abbot) on Feb 28, 2006 at 12:28 UTC

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

Re: Array Shuffle
by QM (Parson) on Feb 28, 2006 at 18:12 UTC
    What happens if the array has only 1 element?

    Quantum Mechanics: The dreams stuff is made of

Re: Array Shuffle
by Discipulus (Canon) on Feb 28, 2006 at 10:14 UTC
    quick and dirty:
    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; }
    cheers lorenzo*

      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(@_); }
      2. sub shuffleArray{ my @p = @_; my $k; $k = $_ + int(rand(@p - $_)), @p[$_, $k] = @p[$k, $_] for 0 .. @p - 1; @p; }
      3. sub shuffleArray{ my @p = @_; map { splice @p, $_ + rand(@p - $_), 1, $p[$_] } 0 .. @p - 1; }
      4. sub shuffleArray{ my @p = @_; my $t; map { $t = splice @p, rand(@p), 1, $p[0]; shift @p; $t } 0 .. +@p - 1; }
      5. sub shuffleArray{ my @w = map { rand } @_; @_[sort { $w[$a] <=> $w[$b] } 0 .. @_ - 1]; }
      6. sub shuffleArray{ map { $$_[1] } sort { $$a[0] <=> $$b[0] } map { [rand, $_] } @ +_; }
      7. sub shuffleArray{ map { $$_[0] } sort { ref $a <=> ref $b } map { bless [$_], ra +nd } @_; }

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://533228]
Approved by McDarren
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (2)
As of 2024-07-22 05:50 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.