aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLubos Kolouch <lubos@kolouch.net>2025-10-23 12:19:29 +0200
committerLubos Kolouch <lubos@kolouch.net>2025-10-23 12:19:29 +0200
commit6acef64f10624248a7ea5c2458661d0986d3afc3 (patch)
tree48c9ed6c3dc735fc15120b21e281d6c1f298eba9
parent7c0847cc89f19213cb933727c8a775e5409c5d4f (diff)
downloadperlweeklychallenge-club-6acef64f10624248a7ea5c2458661d0986d3afc3.tar.gz
perlweeklychallenge-club-6acef64f10624248a7ea5c2458661d0986d3afc3.tar.bz2
perlweeklychallenge-club-6acef64f10624248a7ea5c2458661d0986d3afc3.zip
Add Perl ch-2 solution for challenge 344
-rw-r--r--challenge-344/lubos-kolouch/perl/ch-2.pl68
1 files changed, 68 insertions, 0 deletions
diff --git a/challenge-344/lubos-kolouch/perl/ch-2.pl b/challenge-344/lubos-kolouch/perl/ch-2.pl
new file mode 100644
index 0000000000..d80ea09097
--- /dev/null
+++ b/challenge-344/lubos-kolouch/perl/ch-2.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+
+# Perl Weekly Challenge: Task 2 - Array Formation
+# Determine whether the target array can be formed by concatenating source subarrays without reordering their elements.
+
+use strict;
+use warnings;
+use v5.30;
+
+# Enable signatures for clarity.
+use experimental 'signatures';
+
+# Check if @target can be built by reordering the subarrays in @source and concatenating them.
+## no critic (Subroutines::ProhibitSubroutinePrototypes)
+sub array_formation ( $source_ref, $target_ref ) {
+ my @source = $source_ref->@*;
+ my @target = $target_ref->@*;
+ my $target_length = @target;
+ my @used = (0) x @source;
+ my $index = 0;
+
+ while ( $index < $target_length ) {
+ my $matched = 0;
+
+ for my $i ( 0 .. $#source ) {
+ next if $used[$i];
+ my @piece = $source[$i]->@*;
+ next unless @piece;
+ next unless $piece[0] == $target[$index];
+
+ my $len = @piece;
+ next if $index + $len > $target_length;
+
+ my $fits = 1;
+ for my $offset ( 0 .. $len - 1 ) {
+ if ( $piece[$offset] != $target[ $index + $offset ] ) {
+ $fits = 0;
+ last;
+ }
+ }
+
+ next unless $fits;
+
+ $used[$i] = 1;
+ $index += $len;
+ $matched = 1;
+ last;
+ }
+
+ return 'false' unless $matched;
+ }
+
+ return 'true';
+}
+
+# Unit tests
+use Test::More;
+
+is( array_formation( [ [ 2, 3 ], [1], [4] ], [ 1, 2, 3, 4 ] ),
+ 'true', 'Example 1: ([2,3],[1],[4]) -> (1,2,3,4)' );
+is( array_formation( [ [ 1, 3 ], [ 2, 4 ] ], [ 1, 2, 3, 4 ] ),
+ 'false', 'Example 2: ([1,3],[2,4]) -> (1,2,3,4)' );
+is( array_formation( [ [ 9, 1 ], [ 5, 8 ], [2] ], [ 5, 8, 2, 9, 1 ] ),
+ 'true', 'Example 3: ([9,1],[5,8],[2]) -> (5,8,2,9,1)' );
+is( array_formation( [ [1], [3] ], [ 1, 2, 3 ] ), 'false', 'Example 4: ([1],[3]) -> (1,2,3)' );
+is( array_formation( [ [ 7, 4, 6 ] ], [ 7, 4, 6 ] ), 'true', 'Example 5: ([7,4,6]) -> (7,4,6)' );
+
+done_testing();