Week 191 stuff

3 files changed, 98 insertions, 0 deletions

diff --git a/challenge-191/peter-campbell-smith/blog.txt b/challenge-191/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..4721d679a0
--- /dev/null
+++ b/challenge-191/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/11/the-twice-largest-and-number-of-cuties.html
diff --git a/challenge-191/peter-campbell-smith/perl/ch-1.pl b/challenge-191/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..8ce627323f
--- /dev/null
+++ b/challenge-191/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-11-14
+# PWC 191 task 1
+
+use v5.28;
+use utf8;
+use warnings;
+
+# You are given list of integers, @list. Write a script to find out whether the largest item in the list 
+# is at least twice as large as each of the other items.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/11/the-twice-largest-and-number-of-cuties.html
+
+my (@tests, $test, @sorted, $largest, $second, $this);
+
+@tests = ([1, 2, 3, 4], [1, 2, 0, 5], [2, 6, 3, 1], [4, 5, 2, 3], [1, 5, 16, 28, 35, 44, 50, 61, 78, 83, 99, 200]);
+
+# loop over tests
+while ($test = shift @tests) {
+	
+	# method A
+ 	 @sorted = reverse sort {$a <=> $b} @$test;
+	 say qq[\nInput:    \@list = (] . join(', ', @$test) . qq[)\nOutput A: ] . ($sorted[0] >= 2 * $sorted[1] ? '1' : '-1');
+
+	# method B 
+	$largest = $second = 0;
+	for $this (@$test) {
+		if ($this > $largest) {
+			$second = $largest;
+			$largest = $this;
+		}
+	 }
+	 say qq[Output B: ] . ($largest >= 2 * $second ? '1' : '-1');		 
+}
diff --git a/challenge-191/peter-campbell-smith/perl/ch-2.pl b/challenge-191/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..ab0e98814c
--- /dev/null
+++ b/challenge-191/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-11-14
+# PWC 191 task 1
+
+use v5.28;
+use utf8;
+use warnings;
+
+# You are given an integer, 0 < $n <= 15. Write a script to find the number of orderings of numbers that form 
+# a cute list. With an input @list = (1, 2, 3, .. $n) for positive integer $n, an ordering of @list is cute if for 
+# every entry, indexed with a base of 1, either $list[$i] is evenly divisible by $i or  $i is evenly divisible 
+# by $list[$i]
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/11/the-twice-largest-and-number-of-cuties.html
+
+my ($n, @perm, $nn, $x, $cute);
+
+# loop over possible values of $n
+for $nn (1 .. 15) {
+	@perm = (0);
+	$n = $nn;
+	$cute = 0;
+	@perm = find_cute(@perm);
+	shift @perm;
+	say qq[cute[$nn] = $cute];
+}
+
+sub find_cute {   # (@perm)
+
+	# finds all the possible cute sublists comprising @perm and one additional digit
+	# or returns if the list is complete
+	
+	my ($next_index, @perm, $j, $i, @used);
+	
+	# initialise
+	@perm = @_;
+	$next_index = scalar(@perm);
+	
+	# if we have enough digits, increement the cute count and return
+	if ($next_index > $n) {
+		$cute ++;
+		return;
+	}
+
+	# set $used[$i] to 1 if $i has already been used in the string
+	for $i (1 .. $n) {
+		$used[$i] = 0;
+	}
+	for $i (1 .. $next_index) {
+		if (defined($perm[$i])) {
+			$used[$perm[$i]] = 1;
+		}
+	}
+
+	# check whether adding each unused factor and multiple of the index will work as the next element
+	for $j (1 .. $n) {
+		if (not $used[$j] and ($next_index % $j == 0 or $j % $next_index == 0)) {
+			find_cute(@perm, $j);				
+		}
+	}	
+}