秘密圣诞老人 - 生成“有效”排列答案

【问题标题】：Secret Santa - Generating 'valid' permutations秘密圣诞老人 - 生成“有效”排列
【发布时间】：2012-01-26 10:26:32
【问题描述】：

我的朋友邀请我回家玩秘密圣诞老人的游戏，我们应该在其中抽签并为小组中的朋友扮演“圣诞老人”的角色。

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

我们有七个人在玩，所以我认为最终的“圣诞老人分配”是 (1:7) 对自身的排列，但有一些限制。

我想就如何使用 Mathematica 或任何编程语言甚至算法提出各种想法：

列出/打印出所有“有效”的圣诞老人分配
随着玩“秘密圣诞老人”的朋友数量的增长而扩展

【问题讨论】：

原谅我的无知，但这不只是解决到7！ ?可能性的数量。不是那些的确切内容。
@Sheriff 不，它没有。他要求的是不留下任何元素的排列。对于三个元素，（123）（132）（321）（213）被拒绝，（231）和（312）都可以。
@Sheriff，是的，确实如此。嗯！将是排列的总数，但是，其中一些将是“无效的”并且需要考虑。简单的规则是，如果人“i”选择“i”，那么这个“排列”是无效的。如果 1,2,3,..n 是人 & P(1), P(2)..P(n) 是他们选择的插槽，那么对于每个 1
@Szabolcs -- 是的，你是对的！
致亲密的选民：这就是Mathematica users want their own stack exchange site的原因。

标签： algorithm wolfram-mathematica permutation combinatorics

【解决方案1】：

您要查找的内容称为derangement（另一个可爱的拉丁语单词，如放血和开窗）。

所有排列中的紊乱比例接近 1/e = 大约 36.8% - 因此，如果您正在生成随机排列，请继续生成它们，您很有可能会在 5 或 10 内找到一个随机排列的选择。（10.1% 的几率在 5 个随机排列中找不到一个，每增加 5 个排列就会将找不到错乱的几率降低 10 倍）

This presentation 非常实用，它提供了一个递归算法来直接生成紊乱，而不必拒绝不是紊乱的排列。

【讨论】：

确实，这是一个让我愉快地了解 stack-over-flow 社区的介绍......！我从没想过有一个特殊的术语可以提供这样一个“疯狂，愚蠢”（我的朋友们可能会觉得？！）的想法，我一心想追上去……非常感谢您的及时帮助..！跨度>
@fritz 欢迎来到 StackOverflow，不要忘记接受问题的答案（如果有合适的答案！）:-)

【解决方案2】：

我建议这样做：

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, 空}

{1.482, 空}

忽略代码的透明性，这还可以快几倍：

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

f2[9]; //Timing

{0.162, 空}

【讨论】：

(1) 我有一种预感，可以使用 SparseArray 来加快速度。干得好。 (2) 对于它的价值，（似乎）有一个内置函数可以自动给出 number 的“错位”，但不能自动给出实际的“错位”。请参阅Subfactorial 函数。
感谢这两个“宝石”@Mr.Wizard，我也很喜欢你对 SparseArray 的使用——感谢这款游戏，我真的学到了很多东西！ :) 祝大家节日快乐，新年快乐..！

【解决方案3】：

没有元素映射到自身的排列是derangement。随着 n 的增加，紊乱的比例接近常数 1/e。因此，如果随机选择一个排列，则需要（平均）e 尝试获得一个紊乱。

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

【讨论】：

非常感谢您提供此信息..！尽管它似乎是从总 n!安排，我有一些直觉，这应该有一些“模式”......！ :) 我将尝试实施一些方法来“枚举”Mathematica 中的混乱并探索..！再次感谢..！
@wnoise - 你指出随着 n 的增加，“……紊乱的比例接近常数 1/e。”这让我想起了一类通用的最优停止/搜索问题，称为“秘书问题”，其中出现了相同的 1/e 结果。如果熟悉，您能评论一下精神错乱与“秘书问题”之间的关系吗？（我认为在堆栈世界的某个地方正式提出这将是一个很好的问题，但可能不是在 SO 上。如果值得，请随意收获这个问题的想法，如果在这里回答会浪费时间。）
@telefunkenvf14：我从未听说过“秘书问题”，所以无法发表评论。

【解决方案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}}

编辑

看起来 Mathematica 中的 Combinatorica 包实际上有一个 Derangements 函数，所以你也可以这样做

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

虽然在我的系统上 Derangements[Range[n]] 比上面的函数慢大约 2 倍。

【讨论】：

你的函数可以写得更简洁：secretSanta[n_] := Cases[Permutations@Range@n, a_ /; FreeQ[a - Range[n], 0]]

【解决方案5】：

这并不能回答您关于计算有效混乱的问题，但它提供了一种算法来生成具有以下属性的（可能是您想要的）：

它保证圣诞老人的关系只有一个周期（如果您在 4 岁时玩，您最终不会有 2 对圣诞老人情侣 --> 2 个周期），
即使有大量玩家，它也能高效工作，
如果应用公平，没人知道圣诞老人是谁，
它不需要电脑，只需要一些纸。

这里是算法：

每位玩家都在信封上写下她/他的名字，然后将她/他的名字放在信封内的折叠纸上。
一位值得信赖的玩家（针对上述第 3 项财产）拿起所有的信封，看着信封的背面（没有写名字的地方）洗牌。
信封洗好后，始终看着背面，受信任的玩家将每个信封中的纸张移到下一个。
再次洗牌信封后，信封将被分发给上面有名字的玩家，每个玩家都是信封中名字的圣诞老人。

【讨论】：

【解决方案6】：

我在文档中发现了内置的 Subfactorial 函数，并更改了其中一个示例以生成：

Remove[teleSecretSanta];
teleSecretSanta[dims_Integer] :=
 With[{spec = Range[dims]},
  With[{
    perms = Permutations[spec],
    casesToDelete = DiagonalMatrix[spec] /. {0 -> _}},
   DeleteCases[perms, Alternatives @@ casesToDelete]
   ]
  ]

可以使用Subfactorial查看功能。

Length[teleSecretSanta[4]] == Subfactorial[4]

在 Mr.Wizard 的回答中，我怀疑 teleSecretSanta 可以通过 SparseArray 进行优化。但是，我现在喝得太醉了，无法尝试这种恶作剧。（开玩笑的……我其实太懒太傻了。）

【讨论】：