My weird and pernicious submissions

3 files changed, 103 insertions, 0 deletions

diff --git a/challenge-156/peter-campbell-smith/blog.txt b/challenge-156/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..51be635cb0
--- /dev/null
+++ b/challenge-156/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/03/pernicious-and-weird.html
diff --git a/challenge-156/peter-campbell-smith/perl/ch-1.pl b/challenge-156/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..0a0db93790
--- /dev/null
+++ b/challenge-156/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-03-17
+# PWC 156 task 1
+
+use v5.28;
+use strict;
+use warnings;
+use utf8;
+use Math::Prime::Util 'is_prime';
+
+# Write a script to permute (compute?) first 10 Pernicious Numbers. A pernicious number is a positive 
+# integer which has prime number of ones in its binary representation.
+
+# blog: https://pjcs-pwc.blogspot.com/2022/03/pernicious-and-weird.html
+
+my ($found, $j, $binary, @ones, $count);
+
+# loop over numbers 1 to big
+$found = 0;
+for $j (1 .. 100) {
+	
+	# convert to binary
+	$binary = sprintf('%b', $j);
+	
+	# get a list of the '1' matches and assign it to an array
+	@ones = $binary =~ m|1|g;
+	
+	# count the number of elements in the array
+	$count = scalar @ones;
+	
+	# and we have an answer if the count is prime
+	next unless is_prime($count);
+	say $j;	
+	last if $found ++ == 9;
+}
diff --git a/challenge-156/peter-campbell-smith/perl/ch-2.pl b/challenge-156/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..f8bc4102c8
--- /dev/null
+++ b/challenge-156/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-03-17
+# PWC 156 task 2
+
+# Write a script to find out if a number is a Weird Number, defined as:
+# The sum of the proper divisors (divisors including 1 but not itself) of 
+# a weird number is greater than the number, but no subset of those divisors 
+# sums to the number itself.
+
+# blog: https://pjcs-pwc.blogspot.com/2022/03/pernicious-and-weird.html
+
+use v5.28;
+
+my (@tests, $test, $sum, @divisors, $divisor, $num_subsets, $bit, $j, $bad, $num_divisors);
+
+@tests = (12 .. 70, 836);
+
+for $test (@tests) {
+	
+	$sum = 0;
+	@divisors = ();
+	$bad = '1 - good';
+	
+	# find the proper divisors and their sum
+	$j = 0;
+	for $divisor (1 .. $test / 2) {
+		next unless $test / $divisor == int($test / $divisor);
+		$divisors[$j ++] = $divisor;
+		$sum += $divisor;
+	}
+	
+	# first test - does sum of divisors exceed given number?
+	if ($sum <= $test) {
+		$bad = qq[0 - divisor sum ($sum) too small];
+	
+	# second test - does any subset of divisors sum to the given number?
+	} else {
+			
+		# loop over subsets of divisors: there are 2 ** (number of divisors) subsets
+		# and we can loop over them by treating 1 .. (number of subsets - 1) as a binary 
+		# mask to determine which divisors we sum
+		
+		$num_divisors = scalar @divisors;
+		$num_subsets = 2 ** $num_divisors;
+		for ($j = $num_subsets - 1; $j >= 0; $j --) {
+					
+			# make a sum of one subset of divisors
+			$sum = 0;
+			$bit = $num_divisors - 1;
+			for $b (0 .. $bit) {
+				$sum += $divisors[$bit] if $j & (2 ** $bit);
+				last if $sum > $test;
+				$bit --;
+			}
+			
+			# no good
+			if ($sum == $test) {
+				$bad = '0 - divisor sum matches number';
+				last;
+			}
+		}
+	}	
+	say qq[\nInput:  $test\nOutput: $bad];
+}
+