Merge pull request #12888 from pjcs00/wk344

Week 344 - Hip, hip, array!

3 files changed, 87 insertions, 0 deletions

diff --git a/challenge-344/peter-campbell-smith/blog.txt b/challenge-344/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..01f0d8798b
--- /dev/null
+++ b/challenge-344/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/344
diff --git a/challenge-344/peter-campbell-smith/perl/ch-1.pl b/challenge-344/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..e9f4e95e53
--- /dev/null
+++ b/challenge-344/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-10-20
+use utf8;     # Week 344 - task 1 - Array form compute
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+
+array_form_compute([1, 2, 3, 4], 12);
+array_form_compute([2, 7, 4], 181);
+array_form_compute([9, 9, 9], 1);
+array_form_compute([0, 1, 2, 3, 4], -17);
+array_form_compute([1, 2, 3, 4], -1000);
+array_form_compute([1, 2, 3, 4], -1234);
+array_form_compute([0], 12345);
+
+sub array_form_compute {
+	
+	say qq[\nInput:  \@ints = (] . join(', ', 
+		@{$_[0]}) . qq[), \$x = $_[1]];
+		
+	# do it
+	say qq[Output: (] . 
+		join(', ', split('', join('', @{$_[0]}) + $_[1]))
+		. ')';
+}
diff --git a/challenge-344/peter-campbell-smith/perl/ch-2.pl b/challenge-344/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..0609b3d1aa
--- /dev/null
+++ b/challenge-344/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-10-20
+use utf8;     # Week 344 - task 2 - Array formation
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+use Algorithm::Combinatorics 'permutations';
+
+array_formation([[2, 3], [1], [4]], [1, 2, 3, 4]);
+array_formation([[1, 3], [2], [4]], [1, 2, 3, 4]);
+array_formation([[9, 1], [5, 8], [2]], [5, 8, 2, 9, 1]);
+array_formation([[1], [3]], [1, 2, 3]);
+array_formation([[1], [2], [3], [4]], [1, 2, 3]);
+array_formation([[3, 5], [2, 6, 5], [4, 1, 5], [3, 1], [9]], [3, 1, 4, 1, 5, 9, 2, 6, 5, 3, 5]);
+
+sub array_formation {
+	
+	my (@source, @target, $iter, $c, @trial, $j, $explain, $source_text, $source_count);
+	
+	# initialise
+	@source = @{$_[0]};
+	@target = @{$_[1]};
+	$source_text .= '[' . join(', ', @{$source[$_]}) . ']' for 0 .. $#source;
+	$source_text =~ s|\Q][|], [|g for 0 .. $#source;	
+	say qq{\nInput:  \@source = ($source_text)\n        \@target = (} . join(', ', @target) . ')';
+	
+	# must be same number of numbers in source and target
+	$source_count += @{$_} for @source;
+	if ($source_count == @target) {
+	
+		$iter = permutations(\@source);
+			
+		# loop over all perms of source sub-arrays
+		ITER: while ($c = $iter->next) {
+			@trial = ();
+			$explain = '';
+			
+			# concatenate the sources
+			for (@$c) {
+				push @trial, @{$_};
+				$explain .= '(' . join(', ', @{$_}) . '), ';
+			}
+			
+			# check if the concatenated sources match the target
+			for $j (0 .. $#target) {
+				next ITER unless $trial[$j] == $target[$j];
+			}
+			
+			# they do!
+			say qq[Output: true -- ] . substr($explain, 0, -2);
+			return;		
+		}
+	}
+	say qq[Output: false];
+}