Suppose there are n people in an office. At Christmas they have a random gift exchange in which every name is writen on scraps of paper, mixed around in a hat, and then everyone draws a name at random to determine who they are to get a gift for.
What is the probability nobody draws their own name?
An example of all 44 derangements of 5 letters is as follows:
First those 4 x 9 = 36 in which the last letter is swapped with one of the other letters after all the other letters have been deranged, so that the original letter of the position in which the last letter (e in this instance) is not now in the last position:
eabcd
ecabd
edbac
edacb
eadbc
ecdab
ecbad
edabc
eadcb
debca
deabc
cebad
beacd
cedba
bedac
debac
ceabd
bedca
daecb
dceba
cdeab
bdeca
caebd
bcead
dceab
cdeba
baecd
dabec
dcaeb
cdbea
bdaec
cadeb
bcdea
dcbea
cdaeb
badec
And then the 4 x 2 = 16 in which the last letter is swapped with one of the other letters while (or after or before; it doesn't matter), while the nonswapped letters are deranged:
edbca
ecdba
deacb
cedab
daebc
bdeac
cabed
bcaed
They were produced by the following program, which separates the two above groups with a blank line (debugging variable how$ is included and the line that prints it out is commented out with an apostrophe):
DECLARE SUB derange (noSubst)
DIM SHARED exempt(26), subPos(26), subPos2(26), xtra$(26), how$(26)
DIM SHARED noExempt, basStr$
INPUT "Size:", sz
basStr$ = LEFT$("abcdefghijklmnopqrstuvwxyz", sz)
derange 0 ' no substitutions yet
END
SUB derange (noSubst)
FOR i = LEN(basStr$) TO 1 STEP 1
IF exempt(i) = 0 THEN rtmost = i: EXIT FOR
NEXT
IF noExempt < LEN(basStr$)  1 THEN
FOR i = 1 TO rtmost  1
IF exempt(i) = 0 THEN
noS2 = noSubst + 1
subPos(noS2) = i
exempt(rtmost) = 1
subPos2(noS2) = rtmost
noExempt = noExempt + 1
how$(noS2) = "A"
derange noS2
exempt(rtmost) = 0
noExempt = noExempt  1
END IF
NEXT
IF noExempt < LEN(basStr$)  2 THEN
FOR i = 1 TO rtmost  1
IF exempt(i) = 0 THEN
noS2 = noSubst + 1
subPos(noS2) = i
exempt(i) = 1
noExempt = noExempt + 1
exempt(rtmost) = 1
subPos2(noS2) = rtmost
noExempt = noExempt + 1
how$(noS2) = "X"
derange noS2 ' does not derange position i before swap
exempt(rtmost) = 0
exempt(i) = 0
noExempt = noExempt  1
noExempt = noExempt  1
END IF
NEXT
END IF
ELSE
IF noExempt = LEN(basStr$)  1 THEN
p$ = basStr$
FOR i = noSubst TO 1 STEP 1
h$ = MID$(p$, subPos(i), 1)
MID$(p$, subPos(i), 1) = MID$(p$, subPos2(i), 1)
MID$(p$, subPos2(i), 1) = h$
'PRINT subPos(i), subPos2(i), how$(i)
NEXT
PRINT p$
'
END IF
END IF
END SUB
Edited on October 11, 2003, 9:50 pm

Posted by Charlie
on 20031011 21:47:56 