Merge pull request #5671 from pjcs00/wk152

Solutions to week 152

3 files changed, 145 insertions, 0 deletions

diff --git a/challenge-152/peter-campbell-smith/blog.txt b/challenge-152/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..b7e58197e8
--- /dev/null
+++ b/challenge-152/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/02/lots-of-angles-this-week.html
diff --git a/challenge-152/peter-campbell-smith/perl/ch-1.pl b/challenge-152/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..af8adf3bd7
--- /dev/null
+++ b/challenge-152/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-02-17
+# PWC 152 task 1
+
+use v5.28;
+use strict;
+use utf8;
+
+# You are given a triangle array.
+# Write a script to find the minimum sum path from top to bottom.
+
+my ($test, $answer, @row, $r, @examples, $ex);
+
+$examples[0] = qq[
+    [1], 
+   [5,3], 
+  [2,3,4], 
+ [7,1,0,2], 
+[6,4,5,2,8] ];   # answer is 8
+			
+$examples[1] = qq[
+    [5],
+   [2,3],
+  [4,1,5],
+ [0,1,2,3],
+[7,2,4,1,9] ];   # answer is 9
+
+$examples[2] = qq[
+            [ 9],
+           [ 7, 8],
+         [11,22,33],
+        [ 2, 3, 4, 5],
+      [ 9, 8, 7, 6, 5],
+     [23,34,45,56,67,78],
+   [17, 0,66, 3, 6,42, 1],
+  [ 3, 6,33,11,-5, 6,12, 4],
+[12, 3, 4, 7, 0, 3,-1, 2,99] ];   # answer is 51
+						 
+# loop over examples
+for $ex (0..$#examples) {
+	
+	# evaluate example string as array ref of array refs
+	say qq[\nInput:$examples[$ex]];
+	$test = eval("[$examples[$ex]]");
+	
+	# add the least members of each row
+	$answer = 0;
+	for $r (0..$#{$test}) {
+		@row = @{$test->[$r]};
+		$answer += smallest(@row);
+	}
+	
+	say qq[\nOutput: $answer];
+}
+
+sub smallest {
+	
+	my ($answer);
+	
+	# returns the least member of the input array
+	$answer = 999;
+	$answer = $_ < $answer ? $_ : $answer for (@_);
+	return $answer;
+}
+			
\ No newline at end of file
diff --git a/challenge-152/peter-campbell-smith/perl/ch-2.pl b/challenge-152/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..d52a3be9e7
--- /dev/null
+++ b/challenge-152/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-02-17
+# PWC 152 task 2
+
+use v5.28;
+use strict;
+use utf8;
+
+# You are given coordinates bottom-left and top-right corner of two rectangles in a 2D plane.
+# Write a script to find the total area covered by the two rectangles.
+
+# The required area is the area of rectangle 1 plus that of rectangle 2 minus any shared area.
+
+my ($example, $area, $horiz_overlap, $vert_overlap, %rect);
+
+for $example (1 .. 4) {
+	
+	# input
+	if ($example == 1) {
+		#         rect    bottom   left     top     right
+		%rect = ( one => {b => -1, l =>  0, t => 2, r => 2},
+				  two => {b =>  0, l => -1, t => 4, r => 4} );
+				  
+	} elsif ($example == 2) {
+		%rect = ( one => {b => -3, l => -1, t => 1, r => 3},
+				  two => {b => -1, l => -3, t => 2, r => 2} );
+
+	} elsif ($example == 3) {   # rect2 wholly within rect1
+		%rect = ( one => {b => -2, l => -2, t => 2, r => 2},
+				  two => {b => -1, l => -1, t => 1, r => 1} );
+				  
+	} elsif ($example == 4) {   # no overlap
+		%rect = ( one => {b => 0, l => 0, t => 2, r => 2},
+				  two => {b => 2, l => 2, t => 4, r => 4} );
+	}
+	
+	say qq[\nExample $example\nInput:  Rectangle 1 => ($rect{one}{b}, $rect{one}{l}), ($rect{one}{t}, $rect{one}{r})
+	Rectangle 2 => ($rect{two}{b}, $rect{two}{l}), ($rect{two}{t}, $rect{two}{r})];
+			 
+	# Assume no overlap for now
+	$area = area('one') + area('two');
+				  
+	# The rectangles may overlap if the bottom of rect1 is below the top of rect2
+	# and the top of rect1 is above the bottom of rect2
+	$vert_overlap = $rect{one}{b} < $rect{two}{t} && $rect{one}{t} > $rect{two}{b};
+
+	# They may also overlap if the right of rect1 is to the right of the left of rect2
+	# and the left of rect1 is to the left of the right side of rect2
+	$horiz_overlap = $rect{one}{r} > $rect{two}{l} && $rect{one}{l} < $rect{two}{r};
+
+	# They do overlap if both of these conditions are true
+	if ($vert_overlap && $horiz_overlap) {
+		
+		# ... and the overlap area is bounded by the greater of the bottoms,
+		# the lesser of the tops, the leftmost of the rights and the rightmost 
+		# of the lefts		
+		$rect{overlap}{b} = $rect{one}{b} > $rect{two}{b} ? $rect{one}{b} : $rect{two}{b};
+		$rect{overlap}{t} = $rect{one}{t} > $rect{two}{t} ? $rect{two}{t} : $rect{one}{t};
+		$rect{overlap}{l} = $rect{one}{l} > $rect{two}{l} ? $rect{one}{l} : $rect{two}{l};
+		$rect{overlap}{r} = $rect{one}{r} > $rect{two}{r} ? $rect{two}{r} : $rect{one}{r};
+		
+		$area -= area('overlap');
+	} else {
+		say qq[   No overlap];
+	}
+	
+	say qq[Output: $area];
+}
+
+sub area {
+	
+	my $this = shift;
+	my $area = ($rect{$this}{t} - $rect{$this}{b}) * ($rect{$this}{r} - $rect{$this}{l});
+	say qq[   Area of $this is $area];
+	return $area;
+}
+