Secret Santa Shuffling

santa.pl

#!/usr/bin/perl

use strict;
use warnings;
use 5.32.1;
# use Email::Sender::Simple qw(sendmail);
use Email::Stuffer;

# Ian McDougall, Dec 2022
# Takes a list in the format "email@example.com name", one per line
# Sends a name to each email address such that:
#	1. nobody gets themselves
#	2. nobody gets the name immeiately above or below them
#	3. all the names form a single continuous "cycle"
#	4. assignments are otherwise, at least mostly, random
# Probably breaks down with 5 or fewer people.

my @santas;
my @recips;
while (<>)
{	chomp;
	my ($email, $name) = split;
	push @santas, $email;
	push @recips, $name;
}

@recips = santa_shuffle(@recips);

while (@santas)
{	my $giftee = pop @recips;
	my $body = "You're getting a shirt for $giftee. Check the pins for details.";
	Email::Stuffer	->to		(pop @santas)
					->from		('Santa <mcdougall.ian.e@gmail.com')
					->subject	('Secret Santa Shirts')
					->text_body	($body)
					->send;
}

sub fy_shuffle	# Fisher-Yates algothrim
{	my @list = @_;
	my $i = @list;
	while ($i>0)
	{	$i--;
		my $j = int(rand($i+1));
		if ($i != $j)
		{	@list[$i,$j] = @list[$j,$i];
		}
	}
	return @list;
}

sub sattolo_shuffle	# Sattolo's algorithm
{	my @list = @_;
	my $i = @list;
	while ($i>0)
	{	$i--;
		my $j = int(rand($i));
		@list[$i,$j] = @list[$j,$i];
# 		say "$i\t$j";
	}
	return @list;
}

sub no_shuffle	# not an algorithm
{	my @inlist = @_;
	my @outlist;
	while (@inlist>0)
	{	unshift @outlist, splice(@inlist, @inlist-1, 1);
	}
	return @outlist;
}

sub santa_shuffle	# the special suace
{	my @in = @_;
	my @index = (0..$#in);
	my @outdex= (' ') x scalar(@in);
	my $santa = shift @index;	# 0 gives first and gets last
	while (@index > 5)
	{	my @nowdex = map {($index[$_] > $santa + 1 || $index[$_] < $santa -1) ? $_ : () } 0..$#index;	# array of valid indices (not values) of @index
		my $gives = $nowdex[int(rand($#nowdex))];	# choose a random nowdex element (its /value/ is an idex of @indexd) (I did this to myself)
		my $next_santa = $index[$gives];	# capture this now to dodge the splice mucking up the indices
		@outdex[$santa] = splice(@index, $gives, 1);	# the index is removed from the list and its value is given to the current santa in outdex
		$santa = $next_santa;	# the current recipient becomes the next santa
	}
	# INITIATE THE STARFORM PROTOCOL
	my @nowdex	= map {($index[$_] > $santa +1 || $index[$_] < $santa -1) ? $_ : () } 0..$#index;
	@nowdex		= map {($_ != 2) ? $_ : () } @nowdex; # pick can't be 2nd element, or you'll potentially be forced to pick an adjacent element to start the star
	my $gives = $nowdex[int(rand($#nowdex))];
	my $next_santa = $index[$gives];
	@outdex[$santa] = splice(@index, $gives, 1);
	$santa = $next_santa;
	if ($gives == 4 || $gives == 0)
	{	$gives = (1,3)[int(rand(2))];
	}
	if ($gives == 3)	# clockwise star
	{	@outdex[$santa] = $index[1];
		@outdex[$index[1]] = $index[3];
		@outdex[$index[3]] = $index[0];
		@outdex[$index[0]] = $index[2];
		@outdex[$index[2]] = 0;
	} elsif ($gives == 1)	# counterclockwise star
	{	@outdex[$santa] = $index[2];
		@outdex[$index[2]] = $index[0];
		@outdex[$index[0]] = $index[3];
		@outdex[$index[3]] = $index[1];
		@outdex[$index[1]] = 0;
	}
	return @in[@outdex];
}