Merge pull request #12126 from pjcs00/wk324

Week 324 - Fun with arrays

3 files changed, 101 insertions, 0 deletions

diff --git a/challenge-324/peter-campbell-smith/blog.txt b/challenge-324/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..1416761920
--- /dev/null
+++ b/challenge-324/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/324
diff --git a/challenge-324/peter-campbell-smith/perl/ch-1.pl b/challenge-324/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..ec63c77417
--- /dev/null
+++ b/challenge-324/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-06-02
+use utf8;     # Week 324 - task 1 - 2d array
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+
+two_d_array([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12], 3, 4);
+two_d_array([1, 2, 3], 1, 3);
+two_d_array([1, 2, 3, 4], 4, 1);
+
+# bigger example
+my $matrix;
+push @$matrix, int(rand(1000)) for 0 .. 76;
+two_d_array($matrix, 11, 7);
+
+sub two_d_array {
+	
+	my ($integers, $rr, $cc, $j, $r, $c, $array, $w);
+	
+	# initialise
+	($integers, $rr, $cc) = @_;
+	if (@$integers != $rr * $cc) {
+		say qq[\@integers must have $rr * $cc elements];
+		exit;
+	}
+	
+	# get width of largest number for formatting matrix
+	$w = 0;
+	$w = length($_) > $w ? length($_) : $w for @$integers;
+	
+	# fill in matrix
+	for $j (0 .. @$integers - 1) {
+		$r = int($j / $cc);
+		$c = $j % $cc;
+		$array->[$r]->[$c] = sprintf("%${w}d", $integers->[$j]);
+	}
+	
+	# report
+	say qq[\nInput:  \@integers = (] . join(', ', @$integers) . qq[), \$rows = $rr, \$cols = $cc];
+	print_matrix('Output: @matrix =  ', $array);
+}
+
+sub print_matrix {
+	
+	my ($legend, $matrix, $j);
+
+	# format matrix
+	($legend, $matrix) = @_;
+	for $j (0 .. @$matrix - 1) {
+		say qq{$legend [} . join(', ', @{$matrix->[$j]}) . qq(]);
+		$legend = ' ' x length($legend);
+	}
+}
+
diff --git a/challenge-324/peter-campbell-smith/perl/ch-2.pl b/challenge-324/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..c7a14a060f
--- /dev/null
+++ b/challenge-324/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-06-02
+use utf8;     # Week 324 - task 2 - Total xor
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+use Algorithm::Combinatorics 'subsets';
+
+total_xor(5, 1, 6);
+total_xor(3, 4, 5, 6, 7, 8);
+total_xor(1, 3, 6, 8, 9, 15);
+total_xor(7, 8, 9, 10, 11, 12);
+total_xor(2, 4, 6, 8, 10, 12);
+
+# bigger example
+my @array;
+push @array, int(rand(2000)) for 0 .. 16;
+total_xor(@array);
+
+sub total_xor {
+	
+	my (@array, $total, $iter, $subtotal, $s, $i);
+	
+	# initialise
+	@array = @_;
+	$total = 0;
+	$iter = subsets(\@array);
+	
+	# iterate over subsets
+	while ($s = $iter->next) {
+		$subtotal = 0;
+		$subtotal = $subtotal ^ $_ for @$s;
+		$total += $subtotal;
+	}
+	
+	# report
+	say qq[\nInput:  \@array = (] . join(', ', @array) . ')';
+	say qq[Output: $total];
+}