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 non-swapped 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 2003-10-11 21:47:56