Probabilité que l'arrangement Secret Santa se traduira par des accords parfaits

Donc, nous avions Secret Santa au travail.

Nous sommes 8 personnes. Nous avons chacun tour à tour et tiré un petit morceau de papier d'un bol avec un nom dessus. La seule règle: si vous tirez votre nom, vous devez remettre le morceau de papier dans le bol et réessayer.

Appelons les gens A, B, C, D, E, F, G, H, qui est également l'ordre dans lequel ils ont choisi leur morceau de papier.

Nous avons fait l'échange de cadeaux hier soir.

A était le père Noël secret de F.
B était le père Noël secret d'E.
C était le père Noël secret de D.
D était le père Noël secret de C.
E était le père Noël secret de B.
F était le père Noël secret de A.
G était le père Noël secret de H.
H était le père Noël secret de G.

Tu vois ce qui s'est passé? Nous avons fait des couples.

A et F étaient le père Noël secret de l'autre.
B et E étaient le père Noël secret de l'autre.
C et D étaient le père Noël secret de l'autre.
G et H étaient le père Noël secret de l'autre.

Quelle est la probabilité que cela se produise et comment la calculez-vous?

$2n$

S'ils correspondent à des appariements parfaits, ils sont le produit de transpositions disjointes . Cela implique que leur structure de cycle est de la forme

$2n$$n!$$2^n n!$

ces appariements.

Étant donné que tous ces appariements parfaits sont des dérangements et que tous les dérangements sont également probables, la chance est égale à

$2n=8$$15/2119 \approx 0.00707881$$e/(2^4\, 4!) \approx 0.00707886$

Pour vérifier, cette Rsimulation dessine un million de permutations aléatoires de huit objets, ne retient que ceux qui sont des dérangements et compte ceux qui sont des appariements parfaits. Il produit son estimation, l'erreur standard de l'estimation et un score Z pour le comparer à la valeur théorique. Sa sortie est

       p.hat           se            Z 
 0.006981031  0.000137385 -0.711721705

$0.0066$$0.0073$

paired <- function(x) crossprod(x[x] - 1:length(x))==0
good <- function(x) sum(x==1:length(x)) == 0

n <- 8
set.seed(17)
x <- replicate(1e6, sample(1:n, n))
i.good <- apply(x, 2, good)
i.paired <- apply(x, 2, paired)

n.deranged <- sum(i.good)
k.paired <- sum(i.good & i.paired)
p.hat <- k.paired / n.deranged
se <- sqrt(p.hat * (1-p.hat) / n.deranged)
(c(p.hat=p.hat, se=se, Z=(p.hat - 15/2119)/se))

J'ai été assez impressionné par l'élégance de la réponse @whuber. Pour être honnête, j'ai dû beaucoup me familiariser avec de nouveaux concepts pour suivre les étapes de sa solution. Après y avoir passé beaucoup de temps, j'ai décidé de publier ce que j'avais. Ce qui suit est donc une note exégétique à sa réponse déjà acceptée. De cette façon, il n'y a aucune tentative d'originalité, et mon seul objectif est de fournir des points d'ancrage supplémentaires pour suivre certaines des étapes impliquées.

Alors c'est parti ...

$2n$

2. Peut-on dériver la formule des dérangements?

$n$

$d(n)=(n-1)[d(n-2) + d(n-1)]=$

$=n\,d(n-2)-d(n-2)+n\,d(n-1)-d(n-1)$

$d(n) - n\,d(n-1) = -[d(n-1)-(n-1)\,d(n-2)]$

Remarquant maintenant le parallélisme entre le LHS de cette équation et la partie sur le RHS entre parenthèses, nous pouvons continuer récursivement:

$d(n) - n\,d(n-1)=-[d(n-1)-(n-1)\,d(n-2)] =$

$=(-1)^2\,[d(n-2)-(n-2)\,d(n-3)]=\cdots=(-1)^{n-2}\,d(2)-2\,d(1)$

$d(n) = n\,d(n-1)+(-1)^n$

Travail en arrière:

$d(2)=1$

$d(3)= 3\,d(2)-1 =3*1\,-1$

$d(4)= 4\,d(3)+1 =4*3*1\,-4\,\,+1$

$d(5)= 5\,d(4)-1 =5*4*3*1\,-5*4\,+5\,\,-1$

$d(6)= 6\,d(5)+1 = 6*5*4*3*1\,-6*5*4\,+6*5\,-6\,+1=$

$=6!\left(\frac{1}{2}- \frac{1}{3*2}+\frac{1}{4*3*2}-\frac{1}{5*4*3*2}+\frac{1}{6!}\right)=$

$=6!\left(\frac{1}{6!}-\frac{1}{5!}+\frac{1}{4!}-\frac{1}{3!}+\frac{1}{2!}-\frac{1}{1!}+1\right)$

Donc en général,

$d(n)=n!\left(1-1+\frac{1}{2!}-\frac{1}{3!}+\frac{1}{4!}+\cdots+\frac{1}{n!}\right)$

$e^x$$x=-1$

$d(n)\approx\frac{n!}{e}$

${a,b,c,d,e,f}$${b,d,a,c,f,e}$a -> b -> d -> c after which it returns to ae -> f$(\text {a b d c})(\text{e f})$

$4$

$(2n)!$$2n$$2^n$$n!$$p(2n) = \frac{(2n)!}{2^n n!}$

Pour la Rsimulation:

1. paired <- function(x) crossprod(x[x] - 1:length(x))==0

x[x]$8$Paul -> MariaMaria -> PaulMax -> JohnJohn -> MaxMax -> MariaMaria -> MaxPaul -> JohnJohn -> Paul

i $1$

2. good <- function(x) sum(x==1:length(x)) == 0

$x$$(1,2,3,4,5,6,7,8)$

3.k.paired <- sum(i.good & i.paired) est là pour exclure les permutations appariées comme celle ci-dessus dans le diagramme, qui ne sont pas des dérangements:

v <- c(1,2,3,4,5,6,7,8)
w <- c(1,2,3,5,4,6,7,8)

(c("is v paired?" = paired(v), "is w paired?" = paired(w),
   "is v a derang?" = good(w), "is w a derang?" = good(w)))

# not all paired permutations are derangements.