Special unique solutions for week 252

3 files changed, 99 insertions, 0 deletions

diff --git a/challenge-252/peter-campbell-smith/blog.txt b/challenge-252/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..f879c1046a
--- /dev/null
+++ b/challenge-252/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/252
diff --git a/challenge-252/peter-campbell-smith/perl/ch-1.pl b/challenge-252/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..4dda903106
--- /dev/null
+++ b/challenge-252/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+
+use v5.26;    # The Weekly Challenge - 2024-01-15
+use utf8;     # Week 252 task 1 - Special numbers
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+binmode STDOUT, ':utf8';
+
+my ($j, @ints);
+
+special_numbers(1, 2, 3, 4);
+special_numbers(2, 7, 1, 19, 18, 3);
+special_numbers(7, 7, 7, 7, 11);
+
+for $j (0 .. 31) {
+	push @ints, int(rand(20) + 1);
+}
+special_numbers(@ints);
+
+sub special_numbers {
+	
+	my (@ints, $j, $squares, @specials, $last);
+	
+	# initialise
+	@ints = @_;
+	$last = @ints - 1;
+	
+	# check each member
+	for $j (0 .. $last) {
+		if (($last + 1) / ($j + 1) == int(($last + 1) / ($j + 1))) {
+			$squares += $ints[$j] ** 2;
+			push @specials, $j + 1;
+		}
+	}
+	
+	# show results
+	say qq[\nInput:  \@ints = (] . join(', ', @ints) . ')';
+	say qq[Output: $squares ∵ \@specials: ] . join(', ', @specials);
+}
diff --git a/challenge-252/peter-campbell-smith/perl/ch-2.pl b/challenge-252/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..09ebb5bb0c
--- /dev/null
+++ b/challenge-252/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+use v5.26;    # The Weekly Challenge - 2024-01-15
+use utf8;     # Week 252 task 2 - Unique sum zero
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+binmode STDOUT, ':utf8';
+
+unique_sum_zero(1);
+unique_sum_zero(5);
+unique_sum_zero(50);
+
+sub unique_sum_zero {
+	
+	my ($n, $method, $sum, $j, @array, %used);
+	
+	$n = shift @_;
+	say qq[\nInput:  \$n = $n];
+	
+	# try two ways
+	for $method (1 .. 2) {
+		@array = ();
+		
+		# use -n to +n, including 0 in the middle if an odd number
+		if ($method == 1) {
+			push @array, 0 if $n & 1;
+			for $j (1 .. int($n / 2)) {
+				push @array, -$j;
+				unshift @array, $j
+			}
+					
+		# choose $n - 1 random numbers and add - $sum - unless it has already been used
+		} elsif ($method == 2) {
+			while (1) {
+				$sum = 0;
+				@array = ();
+				%used = ();
+				
+				# fill @array with $n - 1 random integers from the range -$n to +$n
+				while (@array < $n - 1) {
+					$j = int(rand($n * 2)) - $n;
+					next if $used{$j};
+					$used{$j} = 1;
+					push @array, $j;
+					$sum += $j;
+				}
+				
+				# add the negated sum unless it has been used already
+				push @array, -$sum;
+				last unless $used{-$sum};
+			}
+		}
+		
+		# show result
+		$sum = 0;		
+		$sum += $array[$_] for 0 .. $n - 1;
+		say qq[Output: (] . join(', ', @array) . qq[), \$sum = $sum];
+	}	
+}