Week 194 stuff.

3 files changed, 106 insertions, 0 deletions

diff --git a/challenge-194/peter-campbell-smith/blog.txt b/challenge-194/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..9ca0495d84
--- /dev/null
+++ b/challenge-194/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/12/completing-time-and-levelling-letters.html
diff --git a/challenge-194/peter-campbell-smith/perl/ch-1.pl b/challenge-194/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..faa5a17e2a
--- /dev/null
+++ b/challenge-194/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-12-06
+# PWC 194 task 1
+
+use v5.28;
+use utf8;
+use warnings;
+
+# You are given time in the format hh:mm with one missing digit.
+# Write a script to find the highest digit between 0-9 that makes it valid time.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/12/completing-time-and-levelling-letters.html
+
+my (@tests, $test, @chars, $result);
+
+@tests = ('?5:00', '?3:00', '1?:00', '2?:00', '12:?5', '12:5?');
+
+# loop over tests
+for $test (@tests) {
+	@chars = split(//, $test);
+	
+	if ($chars[0] eq '?') {        # ?1:30 or ?5:30
+		$result = $chars[1] > 3 ? '1' : '2';
+		
+	} elsif ($chars[1] eq '?') {   # 1?:30 or 2?:30
+		$result = $chars[0] eq '2' ? '3' : '9';
+		
+	} elsif ($chars[3] eq '?') {   # 11:?0
+		$result = '5';
+		
+	} elsif ($chars[4] eq '?') {   # 11:3?
+		$result = '9';
+		
+	} else {
+		$result = 'invalid';
+	}
+	say qq[\nInput:  $test\nOutput: $result];
+}
diff --git a/challenge-194/peter-campbell-smith/perl/ch-2.pl b/challenge-194/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..c95bc7515e
--- /dev/null
+++ b/challenge-194/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-12-06
+# PWC 194 task 2
+
+use v5.28;
+use utf8;
+use warnings;
+
+# You are given a string made of alphabetic characters only, a-z. Write a script to determine whether removing only 
+# one character can make the frequency of the remaining characters the same.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/12/completing-time-and-levelling-letters.html
+
+my (@tests, $test, @chars, $char, %freq, $max_freq, $max_char, $good, $others_equal, $singles);
+
+@tests = ('abbc', 'xyzyyxz', 'xzxz', 'aaaaa', 'aaabbcc', 'aabbccc', 'x', 'abbcc', 'abc',
+	'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz' . 'q' . 'abcdefghijklmnopqrstuvwxyz' );
+
+for $test (@tests) {
+	%freq = ();
+	$max_freq = 0;
+	
+	# create $freq{'x'} as frequency of 'x' in string
+	@chars = split(//, $test);
+	for $char (@chars) {
+		$freq{$char} ++;
+	}
+	
+	# find the maximum frequency and the (or one of the) characters having that frequency
+	for $char (keys %freq) {
+		if ($freq{$char} > $max_freq) {
+			$max_freq = $freq{$char};
+			$max_char = $char;
+		}
+	}
+	
+	# for each character that isn't $max_char, the frequency must be $max_freq - 1
+	$good = 1;
+	$others_equal = 1;
+	$singles = '';
+	for $char (sort keys %freq) {
+		$good = 0 if ($char ne $max_char and $freq{$char} != $max_freq - 1);
+		
+		# but there is a special case where one char appears once and the rest appear with equal frequency (eg abbcc)
+		if ($freq{$char} == 1) {
+			$singles .= qq['$char' or ] if $freq{$char} == 1;
+		} else {
+			$others_equal &= $freq{$char} == $max_freq;
+		}
+	}
+	
+	# report result
+	if ($good) {
+		say qq[\nInput:  $test\nOutput: 1 as removal of one '$max_char' leaves the remaining frequencies equal];
+	
+	} elsif ($singles and $others_equal) {
+		$singles =~ s|....$||;
+		say qq[\nInput:  $test\nOutput: 1 as removal of $singles leaves the remaining frequencies equal];
+
+	} else {
+		say qq[\nInput:  $test\nOutput: 0 as no single removal leaves the remaining frequencies equal];
+	}
+
+}
+