perl logo Perl logo (Thanks to Olaf Alders)

The weekly challenge 388 - Task 2: Secret Santa

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-388/#TASK2
 3 #
 4 # Task 2: Secret Santa
 5 # ====================
 6 #
 7 # A company with $n employees is running a Secret Santa exchange. Each employee
 8 # buys one gift and receives one gift.
 9 #
10 # Write a script to return the total number of valid gift assignments where no
11 # employee receives the gift they originally bought (i.e., employee $i must not
12 # be assigned gift $i).
13 #
14 ## Example 1
15 ##
16 ## Input: $n = 1
17 ## Output: 0
18 ##
19 ## Only 1 participant exists. They would have to receive their own gift, which is invalid.
20 #
21 ## Example 2
22 ##
23 ## Input: $n = 2
24 ## Output: 1
25 ##
26 ## Participants 1 and 2 must swap gifts ([2, 1]).
27 #
28 ## Example 3
29 ##
30 ## Input: $n = 3
31 ## Output: 2
32 ##
33 ## The 2 valid gift arrays where array[i] is who person i+1 receives from:
34 ## [2, 3, 1]
35 ## [3, 1, 2]
36 #
37 ## Example 4
38 ##
39 ## Input: $n = 4
40 ## Output: 9
41 ##
42 ## The 9 valid arrays are:
43 ## [2, 1, 4, 3], [2, 3, 4, 1], [2, 4, 1, 3],
44 ## [3, 1, 4, 2], [3, 4, 1, 2], [3, 4, 2, 1],
45 ## [4, 1, 2, 3], [4, 3, 1, 2], [4, 3, 2, 1],
46 #
47 ## Example 5
48 ##
49 ## Input: $n = 5
50 ## Output: 44
51 ##
52 ## There are 44 valid permutations out of 5! = 120 total possible arrangements.
53 #
54 ############################################################
55 ##
56 ## discussion
57 ##
58 ############################################################
59 #
60 # We create all possible permutations of the numbers 1..$n.
61 # Then we count the valid ones.
62 
63 use v5.36;
64 use Algorithm::Combinatorics qw(permutations);
65 
66 sub secret_santa($n) {
67     say "Input: $n";
68     my $result = 0;
69     my @input = (1..$n);
70     foreach my $permutation (permutations(\@input)) {
71         $result += is_valid($permutation);
72     }
73     say "Output: $result";
74 }
75 
76 sub is_valid($permutation) {
77     my @p = @$permutation;
78     foreach my $i (0..$#p) {
79         return 0 if $p[$i] == $i+1;
80     }
81     return 1;
82 }
83 
84 secret_santa(1);
85 secret_santa(2);
86 secret_santa(3);
87 secret_santa(4);
88 secret_santa(5);