in reply to Kris Kringle / Secret Santa

If you just match up the givers one by one against randomly chosen recipients, you should be OK most of the time. A test is added to force another choice when the giver :
  1. and randomly chosen recipient are the same person
  2. The giver has given to the recipient before

Unfortunately, the likly hood of completing the task diminishes as the number of people in the list compared to the number of people that they have given to becomes close. The iteration count is added in order to stop an infinite loop if a solution cannot be found. I have decided to terminate the script if a solution is impossible but another loop could be added to keep going until a solution was found.

#! /usr/bin/perl -w use strict; use warnings; my %people = ( jim => ['betty', 'claire'], betty => ['frank', 'jim' ], frank => ['claire', 'john' ], claire => ['john', 'betty' ], john => ['jim', 'frank' ], nancy => ['', '' ], # new girl ); my @allPeople = sort keys %people; my %recipients; @recipients{@allPeople}=undef; srand; # randomize! foreach (@allPeople) { my @remainingPeople = keys %recipients; my $randPerson; my $iterations; do { $randPerson = $remainingPeople[int (rand ($#remainingPeople))] +; $iterations++; die ("ERROR: Failed to generate list\n") unless ($iterations < +$#allPeople); } until (testRecipient($_, $randPerson)); print "$_ can give to $randPerson\n"; delete $recipients {$randPerson}; } sub testRecipient { my ($santa, $recipient) = @_; my $arrayref = $people{$santa}; # test for self giving return 0 if ($santa eq $recipient); #test for giving to the given foreach (@$arrayref){ return 0 if ($_ eq $recipient); } return 1; }

Comments on the code (especially dereferncing the anonymous array reference contained in the hash element) is most welcome!