Week 247 - Christmas is coming!

3 files changed, 93 insertions, 0 deletions

diff --git a/challenge-247/peter-campbell-smith/blog.txt b/challenge-247/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..0734455d93
--- /dev/null
+++ b/challenge-247/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/247
diff --git a/challenge-247/peter-campbell-smith/perl/ch-1.pl b/challenge-247/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..9c6725c2db
--- /dev/null
+++ b/challenge-247/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use v5.26;    # The Weekly Challenge - 2023-12-11
+use utf8;     # Week 247 task 1 - Secret santa
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+secret_santa('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', 
+	'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross', 
+	'Miss Anwar', 'Dr Anwar', 'Lord Anwar');
+
+secret_santa('Rudolph Reindeer', 'Dasher Reindeer', 'Dancer Reindeer',
+	'Prancer Reindeer', 'Vixen Reindeer','Comet Reindeer',
+	'Cupid Reindeer', 'Donner Reindeer', 'Blitzen Reindeer',
+	'Santa Claus', 'Mrs Claus', 'Subordinate Claus');
+				 
+sub secret_santa {
+	
+	my (%people, %recipient, $d, $r, $result, $list, $j);
+	
+	# initialise
+	$people{$_} = int(rand(899) + 101)  for (@_);
+	$list = '   ';
+	
+	# find someone with a different surname
+	D: for $d (sort {$people{$a} <=> $people{$b}} keys %people) {
+		$list .= $d . ($j ++ % 3 == 2 ? qq[,\n   ] : ', ');
+		for $r (sort {$people{$b} <=> $people{$a}} keys %people) {
+			next if ($d eq $r or $people{$r} == 0);
+			if (surname($d) ne surname($r)) {
+				$result .= qq[   $d -> $r\n];
+				$people{$r} = 0;
+				next D;
+			}
+		}
+		
+		# no luck, so try for wih the same one
+		for $r (sort {$people{$a} <=> $people{$b}} keys %people) {
+			next if ($d eq $r or $people{$r} == 0);
+			$result .= qq[   $d -> $r\n];
+			$people{$r} = 0;
+			next D;
+		}	
+	}
+	
+	# show results
+	$list =~ s|,[\n ]+$||;
+	say qq[\nInput:\n$list];
+	say qq[Output:\n] . substr($result, 0, -1);
+}
+
+sub surname {	
+	$_[0] =~ m|([-a-zA-Z']*)$|;
+	return $1;
+}
\ No newline at end of file
diff --git a/challenge-247/peter-campbell-smith/perl/ch-2.pl b/challenge-247/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..3c61498857
--- /dev/null
+++ b/challenge-247/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use v5.26;    # The Weekly Challenge - 2023-12-11
+use utf8;     # Week 247 task 2 - Most frequent letter pair
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+most_frequent('cdeabeabfcdfabgcd');
+most_frequent('abcdefghijklmnopqrstuvwxyz');
+most_frequent('nowisthetimeforallgoodmentocometotheaidoftheparty');
+most_frequent('zyxwvutsrqponmlkjihgfedcba');
+most_frequent('ghghijijij');
+
+sub most_frequent {
+	
+	my ($x, $string, $pair, $count, $best, $most);
+	
+	# initialise
+	$string = $_[0];
+	$best = '';
+	$most = 0;
+	
+	# loop over ab, bc, cd ...
+	for $x ('a' .. 'y') {
+		$pair = $x . chr(ord($x) + 1);
+		
+		# count matches in string
+		$count = () = $string =~ m|$pair|g;
+		if ($count > $most) {
+			$best = $pair;
+			$most = $count;
+		}
+	}
+	
+	# output results
+	say qq[\nInput:  \$s = '$string'\nOutput: ] . ($most ? qq['$best' x $most] : 'none');
+}