Secret Santa - Generando permutaciones "válidas"

Question

Mis amigos me invitaron a casa para jugar el juego de Secret Santa, donde se supone que dibujamos mucho & para jugar el papel de 'Santa' para un amigo en el grupo.

Por lo tanto, escribimos todos nuestros nombres y elegimos un nombre al azar. Si alguno de nosotros termina eligiendo su propio nombre, reorganizamos y seleccionamos los nombres una vez más (la razón fundamental es que uno no puede ser el propio Santa).

Somos siete cuando jugamos, así que pensé en la 'asignación de Santa' final como una permutación de (1: 7) en 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:

• Lista/imprimir todos los Santa-asignaciones 'válidas'
• es escalable a medida que el número de amigos que juegan al 'amigo invisible' crece

Answer 1

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}

Haciendo caso omiso de 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 2

en Mathematica que podría 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 el grupo. A continuación, por ejemplo secretSanta[4] vuelve

{{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 Derangements, por lo que también podría hacer algo como

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

aunque en mi El sistema Derangements[Range[n]] tiene un factor 2 más lento que la función anterior.

Answer 3

Lo que estás buscando se llama derangement (otra hermosa palabra Latinate para saber, como exanguinación y defenestración).

La fracción de todas las permutaciones que son trastornos se aproxima a 1/e = aproximadamente 36.8% - así que si está generando permutaciones aleatorias, solo siga generándolas, y hay una probabilidad muy alta de que encuentre una dentro de 5 o 10 selecciones de una permutación aleatoria. (10.1% de probabilidad de no encontrar uno dentro de 5 permutaciones al azar, cada 5 permutaciones adicionales disminuye la posibilidad de no encontrar un trastorno por otro factor de 10)

This presentation es bastante práctico y da un algoritmo recursivo para generar trastornos directamente, en lugar de tener que rechazar permutaciones que no son trastornos.

Answer 4

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

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

Answer 5

me encontré con la incorporada en el Subfactorial función en la documentación y alteró 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] 
    ] 
    ] 

Se puede usar Subfactorial para verificar la función.

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

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

Answer 6

Esto no responde a tu pregunta sobre el conteo de los trastornos válidos, pero da un algoritmo para generar uno (que podría ser lo que quieras) con los siguientes propiedades:

1. que garantiza que hay un solo ciclo en la relación de Santa (si se juega a las 4, no termina con 2 parejas Santa -> 2 ciclos),
2. funciona eficientemente incluso con número muy grande de jugador,
3. si se aplica con justicia, nadie sabe de quién es Papá Noel,
4. no necesita una computadora, solo papel.

Aquí el algoritmo:

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