秘密圣诞老人 - 生成"有效"排列

Question

我的朋友们邀请我回家玩秘密圣诞老人的游戏,在那里我们应该抽出很多东西,并为小组中的朋友扮演'圣诞老人'的角色.

所以,我们写下所有的名字并随机选择一个名字.如果我们中的任何一个人最终选择了自己的名字,那么我们会重新洗牌并重新挑选名字(理由是一个人不能成为自己的圣诞老人).

我们有七个人在玩,所以我认为最后的"圣诞老人分配"是(1:7)对自身的排列,有一些限制.

我想邀请各种想法,关于我们如何使用Mathematica特定的或任何编程语言甚至算法来:

• 列出/打印出所有"有效"的圣诞老人分配
• 随着玩"秘密圣诞老人"的朋友数量增加,可扩展性

Answer 1

你正在寻找的东西被称为紊乱(另一个可爱的拉丁语单词,如exsanguination和defenestration).

所有排列的部分都是紊乱接近1/e =约36.8% - 因此,如果你要生成随机排列,只需继续生成它们,并且你很有可能在5或10个选择中找到一个随机排列.(在5个随机排列中找不到一个的几率为10.1%,每增加5个排列就会降低未发现另一个因子10的紊乱的几率)

这个演示非常实际,并提供了一个直接生成紊乱的递归算法,而不是必须拒绝不是紊乱的排列.

Answer 2

没有元素映射到自身的排列是一种紊乱.随着n增加,紊乱的分数接近常数1/e.因此,如果随机选择排列,则需要(平均)尝试获得紊乱.

维基百科文章包括用于计算小n的显式值的表达式.

Answer 3

我建议这个:

f[s_List] := Pick[#, Inner[SameQ, #, s, Nor]] & @ Permutations@s

f @ Range @ 4

{{2, 1, 4, 3}, {2, 3, 4, 1}, {2, 4, 1, 3}, {3, 1, 4, 2}, {3, 4, 1, 2},
 {3, 4, 2, 1}, {4, 1, 2, 3}, {4, 3, 1, 2}, {4, 3, 2, 1}}

这比Heike的功能要快得多.

f @ Range @ 9; //Timing
secretSanta[9]; //Timing

{0.483, Null}

{1.482, Null}

忽略代码的透明度,这仍然可以快几倍:

f2[n_Integer] := With[{s = Range@n},
    # ~Extract~ 
       SparseArray[Times@@BitXor[s, #] & /@ #]["NonzeroPositions"] & @ Permutations@s
  ]

f2[9]; //Timing

{0.162, Null}

Answer 4

在Mathematica中你可以做类似的事情

secretSanta[n_] := 
  DeleteCases[Permutations[Range[n]], a_ /; Count[a - Range[n], 0] > 0]

n池中的人数在哪里？然后例如secretSanta[4]返回

{{2, 1, 4, 3}, {2, 3, 4, 1}, {2, 4, 1, 3}, {3, 1, 4, 2}, {3, 4, 1, 2}, 
  {3, 4, 2, 1}, {4, 1, 2, 3}, {4, 3, 1, 2}, {4, 3, 2, 1}}

编辑

看起来CombinatoricaMathematica中的包实际上有一个Derangements函数,所以你也可以做类似的事情

Needs["Combinatorica`"]
Derangements[Range[n]]

虽然我的系统Derangements[Range[n]]比上面的功能慢了2倍.