Merge pull request #7013 from pjcs00/wk189

Week 189's tasks completed

3 files changed, 101 insertions, 0 deletions

diff --git a/challenge-189/peter-campbell-smith/blog.txt b/challenge-189/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..d1d9631d8b
--- /dev/null
+++ b/challenge-189/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/10/the-smallest-greater-and-shortest-slice.html
diff --git a/challenge-189/peter-campbell-smith/perl/ch-1.pl b/challenge-189/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..62036cb6f1
--- /dev/null
+++ b/challenge-189/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-10-31
+# PWC 189 task 1
+
+use v5.28;
+use utf8;
+use warnings;
+binmode(STDOUT, ':utf8');
+
+# You are given an array of characters (a..z) and a target character.
+# Write a script to find out the smallest character in the given array lexicographically greater than the 
+# target character.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/10/the-smallest-greater-and-shortest-slice.html
+
+my (@tests, $test, @array, $target, $k, @x);
+
+@x = split('', 'thequickbrownfoxjumpsoverthelazydog');
+@tests = ([qw/e m u g/], 'b', [qw/d c e f/], 'a', [qw/j a r/], 'o', [qw/d c a f/], 'a', [qw/t g a l/], 'v', 
+	\@x, 'm');
+
+# loop over tests
+TEST: while ($tests[0]) {
+	
+	# get inputs
+	@array = @{ shift @tests };
+	$target = shift @tests;
+	say qq[\nInput:  \@array = qw/] . join(' ', @array) . qq[/, \$target = '$target'];
+	
+	# sort the array and get the first character > $target
+	for $k (sort @array) {
+		next unless ($k gt $target);
+		say qq[Output: $k];
+		next TEST;
+	}
+	say qq[Output: none];
+}
diff --git a/challenge-189/peter-campbell-smith/perl/ch-2.pl b/challenge-189/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..af9953a674
--- /dev/null
+++ b/challenge-189/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-10-31
+# PWC 189 task 2
+
+use v5.28;
+use utf8;
+use warnings;
+binmode(STDOUT, ':utf8');
+
+# You are given an array of 2 or more non-negative integers. Write a script to find out the smallest slice, 
+# ie contiguous subarray of the original array, having the degree of the given array.
+# The degree of an array is the maximum frequency of an element in the array.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/10/the-smallest-greater-and-shortest-slice.html 
+
+my (@tests, $test, @array, $degree, $size, $start, $slice_degree, @slice, $found);
+
+@tests = ([1, 3, 3, 2], [1, 2, 1, 3], [1, 3, 2, 1, 2], [1, 1, 2, 3, 2], [2, 1, 2, 1, 1],
+	[1, 5, 8, 6, 3, 4, 2, 6, 5, 7, 3, 4, 5, 1 ,3, 4, 2, 3, 5, 1, 2, 7, 4, 6, 2, 4, 1, 8, 4, 3],
+	[1, 1, 1, 2, 2, 2]);
+
+TEST: for $test (@tests) {
+	@array = @$test;
+	
+	# get degree of supplied array
+	$degree = get_degree(@array);	
+	say qq[\nInput:  \@array = (]. join(', ', @array), qq[), degree $degree];
+	
+	# now test possible slices from shortest to longest
+	$found = 0;
+	SIZE: for $size ($degree .. scalar @array) {
+		
+		# ... and starting from the beginning up to the last position where rgere are still $size left
+		for $start (0 .. scalar @array - $size) {
+			@slice = @array[$start..$start + $size - 1];
+			$slice_degree = get_degree(@slice);
+			
+			# do we have an answer?
+			if ($slice_degree == $degree) {
+				say qq[Output: (] . join(', ', @slice) . qq[), degree $slice_degree];
+				$found = 1;
+			}
+		}
+		
+		# we have found answer(s) at this $size, so don't look at longer possibilities
+		last SIZE if $found;
+	}
+}
+
+sub get_degree {
+	
+	my ($degree, $j, %freq);
+	
+	# find the frequency of the most frequent element(s)
+	$degree = 0;
+	for $j (@_) {
+		$freq{$j} ++;
+		$degree = $freq{$j} if $freq{$j} > $degree;
+	}
+	return $degree;
+}