Secret Santa - Generazione di permutazioni "valide"

Question

I miei amici mi hanno invitato a casa a giocare a Secret Santa, dove dovremmo disegnare molto & nel ruolo di "Babbo Natale" per un amico del gruppo.

Quindi, scriviamo tutti i nostri nomi e selezioniamo un nome a caso. Se qualcuno di noi finisce per avere il proprio nome scelto, quindi rimescoliamo e selezioniamo i nomi da capo (la logica è che uno non può essere il proprio Babbo Natale).

Ci sono sette di noi mentre suoniamo, quindi ho pensato alla definitiva "allocazione di Babbo Natale" come una permutazione di (1: 7) su se stessa, con alcune restrizioni.

Vorrei invitare diverse idee su come potremmo utilizzare Mathematica, in particolare, o qualsiasi altro linguaggio di programmazione o anche un algoritmo per:

• List/stampare tutti i Santa-allocazioni 'valido'
• è scalabile come il numero di amici che giocano 'Secret Santa' cresce

Answer 1

propongo questo:

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

Questo è significativamente più veloce rispetto la funzione di Heike.

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

{0.483, Null}

{1.482, Null}

Ignorando la trasparenza del codice, questo può essere reso ancora più volte più veloce:

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

f2[9]; //Timing 

{0.162, Null}

Answer 2

In Mathematica si potrebbe fare qualcosa di simile

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

dove n è il numero di persone nel pool. Poi per esempio secretSanta[4] rendimenti

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

Modifica

Sembra che il pacchetto Combinatorica in Mathematica in realtà ha una funzione Derangements, così si potrebbe anche fare qualcosa di simile

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

anche se sul mio sistema Derangements[Range[n]] è circa un fattore 2 più lento della funzione precedente.

Answer 3

Quello che stai cercando è chiamato derangement (un'altra bella parola latina da sapere, come dissanguamento e defenestrazione).

La frazione di tutte le permutazioni che sono disallineamenti si avvicina 1/e = circa 36,8% - quindi se si generano permutazioni casuali, basta continuare a generarle, e c'è un'alta probabilità che ne trovi una entro 5 o 10 selezioni di una permutazione casuale. (10,1% di probabilità di non trovarne uno entro 5 permutazioni casuali, ogni 5 permutazioni addizionali riduce la possibilità di non trovare un disguido da un altro fattore di 10)

This presentation è piuttosto down-to-earth e fornisce un algoritmo ricorsivo per generare direttamente le derangements, piuttosto che dover rifiutare le permutazioni che non sono squilibri.

Answer 4

Una permutazione che non associa alcun elemento a se stesso è un derangement. Con l'aumentare di n, la frazione di squilibri si avvicina alla costante 1/e. In quanto tale, richiede (in media) e cerca di ottenere un disguido, se si sceglie una permutazione a caso.

L'articolo di wikipedia include espressioni per il calcolo di valori espliciti per il piccolo n.

Answer 5

mi sono imbattuto il built-in Subfactorial funzione nella documentazione e modificato uno degli esempi da produrre:

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

È possibile utilizzare Subfactorial per verificare la funzione.

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

Come nella risposta di Mr.Wizard, ho il sospetto teleSecretSanta può essere ottimizzato tramite SparseArray. Tuttavia, sono troppo ubriaco al momento per tentare questi imbrogli. (scherzando ... sono davvero troppo pigro e stupido.)

Answer 6

Questo non risponde alla tua domanda sul conteggio dei disallineamenti validi, ma fornisce un algoritmo per generarne uno (che potrebbe essere quello che vuoi) con il seguente proprietà:

1. si garantisce che ci sia un unico ciclo in rapporto di Babbo Natale (se si gioca in 4, non si finisce con 2 Babbo coppia -> 2 cicli),
2. funziona in modo efficiente anche con numero molto elevato di lettori,
3. se applicato correttamente, nessuno sa di chi sia Babbo Natale,
4. non ha bisogno di un computer, solo della carta.

Ecco l'algoritmo:

• Ogni giocatore scrive la sua/il suo nome su una busta e mette la sua/il suo nome in un foglio piegato nella busta.
• Un giocatore fidato (per la proprietà # 3 sopra) prende tutte le buste e le rimescola guardando sul retro (dove non è scritto alcun nome).
• Una volta che le buste vengono mescolate abbastanza bene, guardando sempre sul retro, il giocatore fidato sposta la carta in ogni busta alla successiva.
• Dopo aver mescolato di nuovo le buste, le buste vengono ridistribuite sul giocatore il cui nome è sopra di esse, e ogni giocatore è il Babbo Natale della persona il cui nome è nella busta.