Week 209 ...

3 files changed, 139 insertions, 0 deletions

diff --git a/challenge-209/peter-campbell-smith/blog.txt b/challenge-209/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..be1df69e9c
--- /dev/null
+++ b/challenge-209/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/209
diff --git a/challenge-209/peter-campbell-smith/perl/ch-1.pl b/challenge-209/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..5f0181121e
--- /dev/null
+++ b/challenge-209/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2023-03-20
+
+use v5.28;
+use utf8;
+use warnings;
+
+# You are given an array of binary bits that ends with 0. Valid sequences in the bit string are:
+# [0] -decodes-to-> "a"
+# [1, 0] -> "b"
+# [1, 1] -> "c"
+# Write a script to print 1 if the last character is an “a” otherwise print 0.
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge/209/1
+
+test_for_a([1, 0, 0]);
+test_for_a([1, 1, 1, 0]);
+test_for_a([1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0]);
+test_for_a([1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0]);
+test_for_a([0]);
+
+sub test_for_a {
+	
+	my (@bits, $bit_string, $good);
+	
+	# get array and convert to string
+	@bits = @{$_[0]};
+	$bit_string = join('', @bits);
+	
+	# if it ends 00 or is just 0 then it ends in 'a'
+	if ($bit_string =~ m|00$| or $bit_string eq '0') {
+		$good = 1;
+		
+	# if it ends 10 then it ends in 'a'	if the final 0 is preceded by an even no of 1s
+	} else {
+		$bit_string =~ m|(1*)0$|;
+		$good = length($1) & 1 ? 0 : 1;
+	}
+	
+	# say the answer
+	say qq[\nInput:  \@bits = (] . join(', ', @bits) . qq[)\nOutput: $good];
+}
diff --git a/challenge-209/peter-campbell-smith/perl/ch-2.pl b/challenge-209/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..24456af3a5
--- /dev/null
+++ b/challenge-209/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2023-03-20
+
+use v5.28;
+use utf8;
+use warnings;
+
+# You are given an array of accounts, ie name with list of email addresses.
+# Write a script to merge the accounts where possible. The accounts can only 
+# be merged if they have at least one email address in common.
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge/209/2
+
+merge_accounts(['A', 'a1@a.com', 'a2@a.com'],
+	['B', 'b1@b.com'],
+	['A', 'a3@a.com', 'a1@a.com']);
+merge_accounts(['A', 'a1@a.com', 'a2@a.com'],
+    ['B', 'b1@b.com'],
+    ['A', 'a3@a.com'],
+    ['B', 'b2@b.com', 'b1@b.com']);
+merge_accounts(['fred', 'fred@gmail.com', 'fgh@fgh.com', 'freddy@home.org'], 
+	['frederick', 'freddy@home.org'],
+	['fbloggs', 'fbloggs@bloggs.co.uk'],
+	['mary', 'freddy@home.org', 'mary@home.org']);
+
+sub merge_accounts {
+	
+	my (@accounts, $a, $j, $k, @acct_name, @emails, $merge, %owns_emails, $email, $rubric, 
+		$line, %lines, $owner, $rubric1);
+	
+	@accounts = @_;  # array of refs to accts
+	
+	# loop over accounts
+	for $j (0 .. scalar @accounts - 1) {
+		
+		# loop over account details
+		$merge = -1;  
+		for $k (0 .. scalar @{$accounts[$j]} - 1) {
+
+			# save account name and emails
+			if ($k == 0) {
+				$acct_name[$j] = $accounts[$j]->[0];
+			} else {
+				$email = $accounts[$j]->[$k];
+				
+				# mark for merging if email has been seen in a previous acct
+				if (defined $owns_emails{$email}) {
+					$merge = $owns_emails{$email};
+				
+				# or record as seen here
+				} else {
+					$owns_emails{$email} = $j;
+				}
+			}
+		}
+		
+		# move emails from this account to $merge
+		if ($merge >= 0) {
+			for $email (keys %owns_emails) {
+				if ($owns_emails{$email} == $j) {
+					$owns_emails{$email} = $merge;
+				}
+			}
+		}			
+	}
+	
+	# format input
+	say qq{\nInput:  \@accounts = [};
+	$rubric = $rubric1 = '';
+	for $j (0 .. scalar @accounts - 1) {
+		$rubric1 = '';
+		for $k (0 .. scalar @{$accounts[$j]} - 1) {
+			$rubric1 .=  qq{'$accounts[$j]->[$k]', };
+		}
+		$rubric1 =~ s|, $||;
+		$rubric .= qq{   [$rubric1],\n};
+	}
+	$rubric =~ s|,\n$|]\n|;
+	say qq{$rubric};
+	
+	# and output
+	for $email (sort keys %owns_emails) {
+		$owner = $owns_emails{$email};
+		$lines{$owner} .= qq['$email', ];
+	}
+	
+	$rubric = '';
+	for $owner (sort keys %lines) {
+		$lines{$owner} =~ s|, $|],|;
+		$rubric .= qq{   ['$accounts[$owner]->[0]', $lines{$owner}\n};
+	}
+	$rubric =~ s|,\n$|]|;
+	say qq{Output: \@accounts = [\n$rubric};
+}