Merge remote-tracking branch 'upstream/master'

3 files changed, 136 insertions, 0 deletions

diff --git a/challenge-203/peter-campbell-smith/blog.txt b/challenge-203/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..a1d240181a
--- /dev/null
+++ b/challenge-203/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2023/02/quads-and-directory-enquiries.html
diff --git a/challenge-203/peter-campbell-smith/perl/ch-1.pl b/challenge-203/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..7a56ca9725
--- /dev/null
+++ b/challenge-203/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2023-02-06
+
+use v5.28;
+use utf8;
+use warnings;
+use Time::HiRes qw(time);
+
+# Task: You are given an array of integers. Write a script to find out the total special quadruplets for the
+# given array. Special Quadruplets are such that satisfies the following 2 rules: 
+# 1) nums[a] + nums[b] + nums[c] == nums[d]
+# 2) a < b < c < d
+
+# Blog: https://pjcs-pwc.blogspot.com/2023/02/quads-and-directory-enquiries.html
+
+my (@tests, $test, @nums, $a, $b, $c, $d, $last, $rubric, $count, @big, $secs, $max);
+
+@tests = ([1, 2, 3, 6], [1, 1, 1, 3, 5], [3, 3, 6, 4, 5], [3, -2, -5, -4]);
+
+# create a longer test
+for $a (0 .. 150) {
+	$big[$a] = int(rand(50_000));
+}
+push @tests, \@big;
+
+# loop over tests
+say qq[----- simple version -----\n];
+for $test (@tests) {
+	
+	# initialise
+	@nums = @$test;
+	say qq[Input:  \@nums = (] . join(', ', @nums) . ')';
+	
+	$last = scalar(@nums) - 1;
+	$rubric = '';
+	$count = 0;
+	$secs = time;
+	
+	# nested loops over a, b, c and d
+	for $a (0 .. $last - 3) {
+		for $b ($a + 1 .. $last - 2) {
+			for $c ($b + 1 .. $last - 1) {
+				for $d ($c + 1 .. $last) {
+					if ($nums[$a] + $nums[$b] + $nums[$c] == $nums[$d]) {
+						$count ++;
+						$rubric .= qq[\$nums[$a] + \$nums[$b] + \$nums[$c] == \$nums[$d] | $nums[$a] + $nums[$b] + $nums[$c] == $nums[$d]\n];
+					}
+				}
+			}
+		}
+	}
+	say qq[Output: $count (] . sprintf('time: %0.2f', time - $secs) . qq[ secs)\n\n$rubric];
+}
+
+# faster version - abandon each loop if the partial sum exceeds the maximum number in @nums
+say qq[----- improved version -----/n];
+for $test (@tests) {
+	
+	# initialise
+	@nums = @$test;
+	say qq[Input:  \@nums = (] . join(', ', @nums) . ')';
+	
+	$last = scalar(@nums) - 1;
+	$rubric = '';
+	$count = 0;
+	$secs = time;
+	
+	# find the largest number
+	$max = -1e10;
+	for $a (@nums) {
+		$max = $a if $a > $max;
+	}
+	
+	# nested loops over a, b, c and d, but abandon the b and c loops if the partial sum exceeds $max
+	for $a (0 .. $last - 3) {
+		for $b ($a + 1 .. $last - 2) {
+			next if $nums[$a] + $nums[$b] > $max;
+			for $c ($b + 1 .. $last - 1) {
+				next if $nums[$a] + $nums[$b] + $nums[$c] > $max;
+				for $d ($c + 1 .. $last) {
+					if ($nums[$a] + $nums[$b] + $nums[$c] == $nums[$d]) {
+						$count ++;
+						$rubric .= qq[\$nums[$a] + \$nums[$b] + \$nums[$c] == \$nums[$d] | $nums[$a] + $nums[$b] + $nums[$c] == $nums[$d]\n];
+					}
+				}
+			}
+		}
+	}
+	say qq[Output: $count (] . sprintf('time: %0.2f', time - $secs) . qq[ secs)\n\n$rubric];
+}	
diff --git a/challenge-203/peter-campbell-smith/perl/ch-2.pl b/challenge-203/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..5d1326254b
--- /dev/null
+++ b/challenge-203/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2023-02-06
+
+use v5.28;
+use utf8;
+use warnings;
+use Time::HiRes qw(time);
+
+# Task: You are given path to two folders, $source and $target. Write a script that recursively copy the directories 
+# in $source to $target, without copying any contained files.
+
+# Blog: https://pjcs-pwc.blogspot.com/2023/02/quads-and-directory-enquiries.html
+
+my ($base, $source, $target);
+
+$base = '/home/pi/PWC';
+$source = "$base/a/b/c";
+$target = "$base/x/y";
+
+copy_dirs($source, $target);
+
+sub copy_dirs {
+	
+	my ($source, $target, @files, $f);
+	($source, $target) = @_;
+	
+	# read the contents of $source
+	chdir $source;
+	opendir(DIR, '.') or die qq[cannot open $source $!];
+	@files = readdir DIR;
+	closedir DIR;
+	
+	# if there are dirs other than . and .. created them in target
+	for $f (@files) {
+		next if $f =~ m|^\.\.?$|;   # ignore . and ..
+		next unless -d qq[$source/$f];
+		mkdir qq[$target/$f] or die qq[cannot make dir $target/$f $!];
+		say qq[created dir $target/$f];
+		
+		# recurse to create any subfolders
+		copy_dirs (qq[$source/$f], qq[$target/$f]);
+	}
+}
\ No newline at end of file