The weekly challenge 247 - Task 1: Secret Santa

  1 #!/usr/bin/perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-247/#TASK1
  3 #
  4 # Task 1: Secret Santa
  5 # ====================
  6 #
  7 # Task 1: Secret Santa
  8 # Submitted by: Andreas Voegele
  9 #
 10 # Secret Santa is a Christmas tradition in which members of a group are
 11 # randomly assigned a person to whom they give a gift.
 12 #
 13 # You are given a list of names. Write a script that tries to team persons from
 14 # different families.
 15 #
 16 ## Example 1
 17 ##
 18 ## The givers are randomly chosen but don't share family names with the receivers.
 19 ##
 20 ## Input: @names = ('Mr. Wall',
 21 ##                  'Mrs. Wall',
 22 ##                  'Mr. Anwar',
 23 ##                  'Mrs. Anwar',
 24 ##                  'Mr. Conway',
 25 ##                  'Mr. Cross',
 26 ##                  );
 27 ##
 28 ## Output:
 29 ##
 30 ##     Mr. Conway -> Mr. Wall
 31 ##     Mr. Anwar -> Mrs. Wall
 32 ##     Mrs. Wall -> Mr. Anwar
 33 ##     Mr. Cross -> Mrs. Anwar
 34 ##     Mr. Wall -> Mr. Conway
 35 ##     Mrs. Anwar -> Mr. Cross
 36 #
 37 ## Example 2
 38 ##
 39 ## One gift is given to a family member.
 40 ##
 41 ## Input: @names = ('Mr. Wall',
 42 ##                  'Mrs. Wall',
 43 ##                  'Mr. Anwar',
 44 ##                  );
 45 ##
 46 ## Output:
 47 ##
 48 ##     Mr. Anwar -> Mr. Wall
 49 ##     Mr. Wall -> Mrs. Wall
 50 ##     Mrs. Wall -> Mr. Anwar
 51 #
 52 ############################################################
 53 ##
 54 ## discussion
 55 ##
 56 ############################################################
 57 #
 58 # We create all possible permutations for the input. Then we
 59 # eliminate all of those that have two people of the same family
 60 # next to each other. Then we select one of the remaining
 61 # permutations randomly.
 62 
 63 use strict;
 64 use warnings;
 65 use Data::Dumper;
 66 use Algorithm::Permute;
 67 
 68 secret_santa('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', 'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross');
 69 secret_santa('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar');
 70 
 71 sub secret_santa {
 72    my @names = @_;
 73    my @permutations = ();
 74    my $p_iterator = Algorithm::Permute->new ( \@names );
 75    my @current_permutation;
 76    while (my @perm = $p_iterator->next) {
 77       @current_permutation = @perm;
 78       if(valid(@perm)) {
 79          push @permutations, [@perm];
 80       }
 81    }
 82    print Dumper \@permutations;
 83    unless(@permutations) {
 84       push @permutations, [ @current_permutation ];
 85    }
 86    my $which = int(rand(scalar(@permutations)));
 87    my $permutation = $permutations[$which];
 88    my $last = shift @$permutation;
 89    push @$permutation, $last;
 90    foreach my $who (@$permutation) {
 91       print "$last -> $who\n";
 92       $last = $who;
 93    }
 94 }
 95 
 96 sub valid {
 97    my @perm = @_;
 98    my $last = shift @perm;
 99    push @perm, $last;
100    foreach my $name (@perm) {
101       my $family_last = $last;
102       $family_last =~ s/.* //;
103       my $family_this = $name;
104       $family_this =~ s/.* //;
105       return 0 if $family_last eq $family_this;
106       $last = $name;
107    }
108    return 1;
109 }