Secret santa

A company with $n employees is running a Secret Santa exchange. Each employee buys one gift and receives one gift. Write a script to return the total number of valid gift assignments where no employee receives the gift they originally bought (ie employee $i must not be assigned gift $i).

Examples

Example 1
Input: $n = 1
Output: 0
Only 1 participant exists. They would have to receive their own gift,
   which is invalid.

Example 2
Input: $n = 2
Output: 1
Participants 1 and 2 must swap gifts ([2, 1]).

Example 3
Input: $n = 3
Output: 2
The 2 valid gift arrays where array[i] is who person i+1 receives
   from:
[2, 3, 1]
[3, 1, 2]

Example 4
Input: $n = 4
Output: 9
The 9 valid arrays are:
[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],

Example 5
Input: $n = 5
Output: 44
There are 44 valid permutations out of 5! = 120 total possible
   arrangements.

Analysis

I am faced with a conflict here, which is that I misunderstand either the challenge or the examples.

Look at example 4 above. The first valid array is given as 2, 1, 4, 3 and the last as 4, 3, 2, 1. But remember that the last person in the sequence gives his or her gift to the first person, so these sequences are the same: 2 gives to 1, 1 gives to 4, 4 gives to 3 and 3 gives to 2.

In my interpretation (and having experienced many Secret Santa events myself) the number of possible sequences of $n people is ($n - 1)!, for example 6 for 4 people or 24 for 5 people and so on.

So that's what I've submitted, but I'm happy to be proved wrong.

Try it 

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge/388/2

use v5.26;    # The Weekly Challenge - 2026-08-24
use utf8;     # Week 388 - task 2 - Secret Santa
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Algorithm::Combinatorics ('permutations');

secret_santa(2);
secret_santa(3);
secret_santa(4);
secret_santa(5);

sub secret_santa {
    
    my ($people, $result, @names, $iter, $p, @gifts, @sequences);
    
    # initialise
    $people = shift;
    
    # the answer
    $result = 1;
    $result *= $_ for 2 .. $people - 1;
    
    # explanation
    @names = (2 .. $people);
    $iter = permutations(\@names);
    while ($p = $iter->next) {
        @gifts = @$p;
        unshift @gifts, 1;
        push @gifts, 1;
        push @sequences, join(' → ', @gifts);
    }
    
    # report
    say qq[\nInput:  $people];
    say qq[Output: $result];
    say $_ for @sequences;
}

15 lines of code

Output from script

Input:  2
Output: 1
1 → 2 → 1

Input:  3
Output: 2
1 → 2 → 3 → 1
1 → 3 → 2 → 1

Input:  4
Output: 6
1 → 2 → 3 → 4 → 1
1 → 2 → 4 → 3 → 1
1 → 3 → 2 → 4 → 1
1 → 3 → 4 → 2 → 1
1 → 4 → 2 → 3 → 1
1 → 4 → 3 → 2 → 1

Input:  5
Output: 24
1 → 2 → 3 → 4 → 5 → 1
1 → 2 → 3 → 5 → 4 → 1
1 → 2 → 4 → 3 → 5 → 1
1 → 2 → 4 → 5 → 3 → 1
1 → 2 → 5 → 3 → 4 → 1
1 → 2 → 5 → 4 → 3 → 1
1 → 3 → 2 → 4 → 5 → 1
1 → 3 → 2 → 5 → 4 → 1
1 → 3 → 4 → 2 → 5 → 1
1 → 3 → 4 → 5 → 2 → 1
1 → 3 → 5 → 2 → 4 → 1
1 → 3 → 5 → 4 → 2 → 1
1 → 4 → 2 → 3 → 5 → 1
1 → 4 → 2 → 5 → 3 → 1
1 → 4 → 3 → 2 → 5 → 1
1 → 4 → 3 → 5 → 2 → 1
1 → 4 → 5 → 2 → 3 → 1
1 → 4 → 5 → 3 → 2 → 1
1 → 5 → 2 → 3 → 4 → 1
1 → 5 → 2 → 4 → 3 → 1
1 → 5 → 3 → 2 → 4 → 1
1 → 5 → 3 → 4 → 2 → 1
1 → 5 → 4 → 2 → 3 → 1
1 → 5 → 4 → 3 → 2 → 1