algorithm - examples - permutations math

Secret Santa-Generando permutaciones ''validas''

Question

Mis amigos me invitaron a casa para jugar el juego de Secret Santa, donde se supone que debemos dibujar mucho y desempeñar el papel de ''Santa'' para un amigo del grupo.

Entonces, escribimos todos nuestros nombres y escogemos un nombre al azar. Si alguno de nosotros termina por elegir su propio nombre, entonces reorganizamos y seleccionamos los nombres nuevamente (la razón es que uno no puede ser el propio Papá Noel).

Somos siete mientras jugamos, así que pensé en la "asignación de Papá Noel" final como una permutación de (1: 7) sobre sí misma, con algunas restricciones.

Me gustaría invitar a varias ideas sobre cómo podríamos usar Mathematica en particular o cualquier lenguaje de programación o incluso un algoritmo para:

• Listar / imprimir TODAS las asignaciones ''válidas'' de Papá Noel
• Es escalable a medida que crece el número de amigos que juegan ''Secret Santa''

Answer 1

En Mathematica podías hacer algo como

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

donde n es el número de personas en la piscina. Luego, por ejemplo, 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}}

Editar

Parece que el paquete Combinatorica en Mathematica en realidad tiene una función de Derangements , por lo que también podría hacer algo como

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

aunque en mi sistema, los Derangements[Range[n]] es aproximadamente un factor 2 más lento que la función anterior.

Answer 2

Encontré la función Subfactorial incorporada en la documentación y modifiqué uno de los ejemplos para producir:

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

Uno puede usar Subfactorial para verificar la función.

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

Al igual que en la respuesta de Mr.Wizard, sospecho que teleSecretSanta se puede optimizar a través de SparseArray. Sin embargo, estoy demasiado borracho en este momento para intentar tales chanchullos. (Es broma ... En realidad soy demasiado vago y estúpido.)

Answer 3

Esto no responde a su pregunta sobre el conteo de los desajustes válidos, pero proporciona un algoritmo para generar uno (que podría ser lo que usted desea) con las siguientes propiedades:

1. garantiza que hay un solo ciclo en la relación de Santa (si juegas a 4, no terminas con 2 parejas de Santa -> 2 ciclos),
2. Funciona de manera eficiente incluso con un gran número de jugadores,
3. si se aplica de manera justa, nadie sabe de quién es quién,
4. No necesita una computadora, solo papel.

Aquí el algoritmo:

• Cada jugador escribe su nombre en un sobre y lo pone en un papel doblado en el sobre.
• Un jugador de confianza (para la propiedad # 3 anterior) toma todos los sobres y los baraja mirando hacia atrás (donde no se escribe ningún nombre).
• Una vez que los sobres se barajan lo suficientemente bien, siempre mirando hacia la parte posterior, el jugador de confianza mueve el papel de cada sobre al siguiente.
• Después de barajar los sobres nuevamente, los sobres se distribuyen de nuevo al jugador cuyo nombre está en ellos, y cada jugador es el Papá Noel de la persona cuyo nombre está en el sobre.

Answer 4

Lo que estás buscando se llama un derangement (otra palabra latina que debes conocer, como exsanguinación y desinversión).

La fracción de todas las permutaciones que son desajustes se aproxima a 1 / e = aprox. 36.8%; por lo tanto, si está generando permutaciones aleatorias, siga generándolas, y existe una gran probabilidad de que encuentre una dentro de 5 o 10 selecciones de un permutación aleatoria (10.1% de probabilidad de no encontrar una dentro de 5 permutaciones aleatorias, cada 5 permutaciones adicionales reduce la probabilidad de no encontrar un trastorno por otro factor de 10)

Esta presentación es bastante práctica y ofrece un algoritmo recursivo para generar desajustes directamente, en lugar de tener que rechazar las permutaciones que no son desajustes.

Answer 5

Propongo esto:

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

Esto es significativamente más rápido que la función de Heike.

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

{0.483, Null}

{1.482, Null}

Ignorando la transparencia del código, esto se puede hacer varias veces más rápido aún:

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

f2[9]; //Timing

{0.162, Null}

Answer 6

Una permutación que no asigna ningún elemento a sí misma es un derangement . A medida que n aumenta, la fracción de desajustes se aproxima a la constante 1 / e. Como tal, toma (en promedio) e intenta obtener un trastorno, si se elige una permutación al azar.

El artículo de wikipedia incluye expresiones para calcular valores explícitos para n pequeña.