Secret Santa - Создание «действительных» перестановок - PullRequest
Новая
       36

Secret Santa - Создание «действительных» перестановок

28 голосов
/ 23 декабря 2011

Мои друзья пригласили меня домой, чтобы поиграть в игру «Секретный Санта», где мы должны много рисовать и играть роль «Санты» для друга в группе.

Итак, мы пишем все наши имена и выбираем имя случайным образом. Если кто-то из нас в конечном итоге выберет свое собственное имя, то мы будем перетасовывать и подбирать имена заново (обоснование заключается в том, что нельзя быть собственным Санта-Клаусом).

Нас играет семеро, поэтому я думал о финальном «распределении Санты» как о перестановке (1: 7) на себя с некоторыми ограничениями.

Я хотел бы предложить различные идеи о том, как мы могли бы использовать Mathematica в частности или любой язык программирования или даже алгоритм для:

  • Список / распечатка ВСЕХ «действительных» санта-ассигнований
  • Масштабируется по мере роста числа друзей, играющих в 'Secret Santa'

Ответы [ 6 ]

29 голосов
/ 23 декабря 2011

То, что вы ищете, называется расстройство (еще одно прекрасное латинское слово, которое нужно знать, например обескровливание и дефенестрация).

Доля всех перестановок, являющихся отклонениями, приближается 1е = примерно 36,8% - поэтому, если вы генерируете случайные перестановки, просто продолжайте генерировать их, и очень высока вероятность того, что вы найдете одну в пределах 5 или 10 выборок случайной перестановки.(10,1% вероятности не найти одну из 5 случайных перестановок, каждые дополнительные 5 перестановок снижают вероятность не найти отклонения еще на 10%)

Эта презентация довольно проста-Земля и дает рекурсивный алгоритм для непосредственного создания отклонений, вместо того, чтобы отклонять перестановки, которые не являются отклонениями.

15 голосов
/ 23 декабря 2011

Я предлагаю это: 

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

Это значительно быстрее, чем функция Хейке. 

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}
15 голосов
/ 23 декабря 2011

Перестановка, которая не отображает ни одного элемента в себе, представляет собой расстройство . С ростом n доля нарушений приближается к константе 1 / e. Таким образом, требуется (в среднем) e пытается получить расстройство, если выбрать случайную перестановку.

Статья в Википедии включает выражения для вычисления явных значений для малых n.

13 голосов
/ 23 декабря 2011

В 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}}

Редактировать

Похоже, что пакет Combinatorica в Mathematica на самом деле имеет функцию Derangements, так что вы можететакже сделайте что-то вроде 

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

, хотя в моей системе Derangements[Range[n]] примерно в 2 раза медленнее, чем функция выше.

2 голосов
/ 31 декабря 2011

Это не отвечает на ваш вопрос о подсчете действительных неисправностей, но дает алгоритм для генерации (который может быть тем, что вы хотите) со следующими свойствами:

  1. это гарантирует, что в отношениях Санты есть один цикл (если вы играете на 4, у вас не будет 2 пары Санты -> 2 цикла),
  2. работает эффективно даже при очень большом количестве игроков,
  3. если применять справедливо, никто не знает чей кто Санта,
  4. ему не нужен компьютер, только бумага.

Вот алгоритм:

  • Каждый игрок записывает свое имя на конверте и помещает свое имя в свернутую бумагу в конверте.
  • Один доверенный игрок (для свойства # 3 выше) берет все конверты и перетасовывает их, глядя на их обратную сторону (там, где имя не написано).
  • Когда конверты достаточно хорошо перетасованы, всегда обращая внимание на обратную сторону, доверенный игрок перемещает бумагу в каждом конверте в следующий.
  • После повторного перетасовывания конвертов конверты раздаются обратно игроку, чье имя на них, и каждый игрок - это Санта человека, имя которого находится в конверте.
1 голос
/ 26 декабря 2011

Я наткнулся на встроенную функцию 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. Однако в данный момент я слишком пьян, чтобы пытаться совершать такие махинации. (шучу ... Я на самом деле слишком ленив и глуп).

...