       Re: random derangement

• To: mathgroup at smc.vnet.net
• Subject: [mg37435] Re: [mg37416] random derangement
• From: Daniel Lichtblau <danl at wolfram.com>
• Date: Tue, 29 Oct 2002 00:09:36 -0500 (EST)
• References: <200210271133.GAA12182@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

```"DIAMOND Mark R." wrote:
>
> This is not quite aposite to either NG, but there appear to be none better
> ... My apologies.
>
> I am searching for an algorithm for producing a random derangement of, for
> instance, the integers 1 to approx 10000.
>
> I thought Skiena's site might have such an algorithm, but I could not locate
> one. ... Producing all derangements and choosing one at random is marginally
> beyond the capacity of my machine :-)
>
> Cheers,
>
> Mark R. Diamond

One thing that will work efficiently is a modification of a basic random
shuffle. The basic shuffle can be found at

http://forums.wolfram.com/mathgroup/archive/2001/Apr/msg00263.html

The modification is that at step j we insist on moving something between
position j+1 (rather than j) and the end into position j.

derangement = Compile[{{n,_Integer}}, Module[
{deck=Range[n], newj},
Do[
newj = Random[Integer, {j+1,n}];
deck[[{j,newj}]] = deck[[{newj,j}]],
{j,n-1}];
deck
]]

In:= Timing[dd = derangement[10^6];]
Out= {5.25 Second, Null}

Check that this is indeed a derangement:

In:= Select[Transpose[{dd,Range[10^6]}], #[]==#[]&]
Out= {}

(Or you can use MapIndexed for this test):
In:= Apply[Or, MapIndexed[#1==#2[]&, dd]]
Out= False

I think this will give random derangements with equal probabilities
though I don't have a proof of that off the top of my head.

Daniel Lichtblau
Wolfram Research

```

• Prev by Date: Re: Using list output (Newbie)
• Next by Date: Re: Re: Crash problems with 4.2 FrontEnd
• Previous by thread: random derangement
• Next by thread: Re: Re: random derangement