Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Re: Random Derangement Of An Array

by jdporter (Canon)
on Jul 06, 2008 at 11:56 UTC ( #695813=note: print w/replies, xml ) Need Help??


in reply to Random Derangement Of An Array

sub random_derangement { my @i = shuffle( 0 .. $#_ ); my @r; @r[ @i ] = @_[ @i[1..$#i], $i[0] ]; @r }
If you want it to derange the list in place, it's even simpler:
sub derange { my @i = shuffle( 0 .. $#_ ); @_[ @i ] = @_[ @i[1..$#i], $i[0] ]; }

Update: I just realized that this is essentially the idea tye suggested in Re^2: Random Derangement Of An Array (rotate). The difference is that I rotate the entire list of (shuffled) indices. I don't believe breaking up the list into smaller chunks is necessary, and, depending on how that was done, could actually hurt the randomization a bit.

Update Again: Upon further reflection, I believe tye is right. In my algorithm above, some derangements are impossible. I had originally had the same idea — subdividing the set of indices — before I (incorrectly, I now believe) made the above oversimplification. The problem is that I don't know how to partition the set fairly. I did come up with an algorithm, but my intuition says it's not exactly fair either. Here it is; perhaps someone can say how fair it is:

sub random_derangement { my @i = shuffle( 0 .. $#_ ); my @j = @i; my @part; # aoa; will contain the partitions # distribute the elements of @j across the existing partitions ran +domly. # but if there are N partitions, there is a 1/(N+1) chance that th +e element # will be distributed to a new (N+1)th partition. # if the number of existing partitions containing only a single el +ement # is equal to the number of remaining elements of @j, we can't cho +ose # just any partition; we have to distribute the remaining elements + of # @j to each of those existing partitions having a single element. # furthermore, we take a precaution against getting into a situati +on # where we'll have more "singleton" partitions than we have remain +ing # elements in @j while (@j) { my @d = grep { @$_ == 1 } @part; @d = shuffle( @d ); if ( @d == @j ) { push @{ $d[0] }, shift @j; } elsif ( @d+1 >= @j ) { push @{ $part[ rand( @part ) ] }, shift @j; } else { push @{ ($part[ rand( 1 + @part ) ]||=[]) }, shift @j; } } # now do the rotations, re-using @i and @j. @i=(); foreach my $part ( @part ) { push @i, @$part; push @j, @{$part}[ 1 .. $#{$part}, 0 ]; } my @r; @r[ @i ] = @_[ @j ]; @r }
A word spoken in Mind will reach its own level, in the objective world, by its own weight

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (6)
As of 2021-03-03 11:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favorite kind of desktop background is:











    Results (77 votes). Check out past polls.

    Notices?