- Added solutions by Peter Campbell Smith.

2 files changed, 140 insertions, 0 deletions

diff --git a/challenge-138/peter-campbell-smith/perl/ch-1.pl b/challenge-138/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..f346c7be46
--- /dev/null
+++ b/challenge-138/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2021-11-08
+# PWC 138 task 1
+
+use v5.20;
+use warnings;
+use strict;
+
+# You are given a year in 4-digits form.
+# Write a script to calculate the total number of workdays in the given year.
+# For the task, we consider, Monday - Friday as workdays.
+
+# Discussion: A non-leap year contains 52 weeks and one day (52 * 7 + 1 = 365).
+# 52 weeks between 1 January and 30 December will contain 52 * 5 = 260 working days.
+# If 31 December is a working day then the year will contain 261 working days,
+# and if it isn't, then the year will contain just 260.
+#
+# A leap year contains 52 weeks and 2 days, so similarly the number of working days
+# in the year is 260 plus 1 if 30 December is a working day and plus another
+# 1 if 31 December is a working day.
+
+my ($year, @years, $working_days);
+
+use Time::Local;
+
+@years = (2010 .. 2030);
+
+for $year (@years) {
+	$working_days = 5 * 52;
+	$working_days++ if is_working_day($year, 12, 31);
+	$working_days++ if (is_leap($year) and is_working_day($year, 12, 30)); 
+	say qq[Input: \$year = $year\nOutput: $working_days\n];
+}
+
+sub is_working_day {  # ($year, $month, $day)
+
+	# returns 1 if date is a working day, else returns 0
+	#                           s  m  h   d      m         y
+	my @t = localtime(timelocal(0, 0, 12, $_[2], $_[1] - 1, $_[0] - 1900));
+	return ($t[6] >= 1 and $t[6] <= 5) ? 1 : 0;
+}
+
+sub is_leap {
+	
+	# returns 1 if given year is leap or 0 if not
+	my ($test);
+	
+	$test = $_[0];
+	$test = $test / 100 if $test % 100 == 0;  # xx00 years
+	return $test % 4 == 0 ? 1 : 0;
+}
\ No newline at end of file
diff --git a/challenge-138/peter-campbell-smith/perl/ch-2.pl b/challenge-138/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..600e5d46da
--- /dev/null
+++ b/challenge-138/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2021-11-08
+# PWC 138 task 2
+
+use v5.20;
+use warnings;
+use strict;
+
+# You are given a perfect square.
+# Write a script to figure out if the square root of the given number is 
+# same as the sum of 2 or more splits of the given number, eg sqrt(9801) = 98 + 0 + 1 = 99
+
+# Discussion: The tricky requirement is to generate all the splits of a
+# multi-digit number (eg 123456).  Consider the number as a string of n digits.
+# Consider also a binary number with n - 1 digits (eg 01101).  If we generate
+# all such binary numers, and consider each bit to represent whether the
+# corresponding digit in the split is followed by ' + ', we can generate
+# all the splits.  So for example 123456 and 01101 yields 12 + 3 + 45 + 6:
+# a plus has been inserted after the first, second and fifth digits of n
+# because the first, second and fifth bits of the binary number are 1.
+#
+# Once you have all the splits you can 'eval' them to get the sum, and compare
+# it with sqrt(n).
+#
+# There is one slight catch. If n contains am embedded 0 (eg 123056) then
+# you will get splits like 123 + 056.  Perl regards 056 as octal 56, so it
+# is necessary to remove these leading zeroes before the eval.
+
+my (@squares, $square, $root, $gaps, $plus_map, $position, $result, $sum, $since, $good, 
+	$legend0, $legend1, $result2);
+
+# test values
+@squares = (81, 9801, 36**2, 45**2, 55**2, 82**2, 91**2, 92**2, 777**2);
+
+# loop over test values
+for $square (@squares) {
+	
+	# check it really is a sqare
+	$root = sqrt($square);
+	say qq[Input: $square ($root ** 2)];
+	if ($root != int($root) or $square < 10) {
+		say qq[$square is not an integer square >= 10\n];
+		next;
+	}
+	
+	# initialisation
+	$gaps = length($square) - 1;   # no of gaps where we could insert a +
+	$good = 0;
+	$since = '';
+	$legend1 = qq[Output: 1\nsince];
+	$legend0 = qq[Output: 0\nsince];
+	
+	# loop over binary numbers eg if $gaps == 6, from 000001 to 111111
+	for $plus_map (1 .. 2 ** $gaps - 1) {
+		
+		# create a string containing pluses in the appropriate places (eg 123 + 456)
+		$result = '';
+		for $position (0 .. $gaps) {
+			$result .= substr($square, $position, 1);
+			if ($plus_map & (2 ** $position)) {   # use bitwise & to isolate the appropriate bit
+				$result .= ' + ';
+			}
+		}
+		
+		# need to avoid constructs like + 012 as perl regards 012 as an octal number
+		$result2 = $result;
+		$result2 =~ s| 0(\d)| $1|g;
+		
+		# evaluate the string
+		$sum = eval($result2);
+		
+		# good result - sums to the root of the original number - show it
+		if ($sum == $root) {
+			say qq[$legend1 $result == $sum];
+			$good = 1;
+			$legend1 = 'and  ';
+			
+		# bad result - it doesn't; keep this in $since in case no good result is found
+		} else {
+			$since .= qq[$legend0 $result == $sum != $root\n];
+			$legend0 = 'and  ';
+		}
+	}
+	
+	# if there were no good results, list the bad ones
+	print $good ? qq[\n] : qq[$since\n];
+}