Perl Weekly Challenge 344.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 344.
Task 1: Array Form Compute
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints and an integer, $x.
Write a script to add $x to the integer in the array-form.
The array form of an integer is a digit-by-digit representation
stored as an array, where the most significant digit is at the
0th index.
Example 1
Input: @ints = (1, 2, 3, 4), $x = 12
Output: (1, 2, 4, 6)
Example 2
Input: @ints = (2, 7, 4), $x = 181
Output: (4, 5, 5)
Example 3
Input: @ints = (9, 9, 9), $x = 1
Output: (1, 0, 0, 0)
Example 4
Input: @ints = (1, 0, 0, 0, 0), $x = 9999
Output: (1, 9, 9, 9, 9)
Example 5
Input: @ints = (0), $x = 1000
Output: (1, 0, 0, 0)
Array form to number to array form
A trivial solution is to convert from array form to integer, multiplying by powers of 10 and adding, sum, and convert back. This yields a 1.5-liner using the Perl Data Language (PDL).
Examples:
perl -MPDL -E '
for my($x, $y)(@ARGV){$p=pdl($x);$q=($p*10**($p->nelem-1-$p->xvals))->sumover+$y;
$r=pdl([split "", $q]);say "$x, $y -> $r";}
' "[1 2 3 4]" 12 "[2 7 4]" 181 "[9 9 9]" 1 "[1 0 0 0 0]" 9999 "[0]" 1000
Results:
[1 2 3 4], 12 -> [1 2 4 6]
[2 7 4], 181 -> [4 5 5]
[9 9 9], 1 -> [1 0 0 0]
[1 0 0 0 0], 9999 -> [1 9 9 9 9]
[0], 1000 -> [1 0 0 0]
The corresponding full code is:
1 # Perl weekly challenge 344
2 # Task 1: Array Form Compute
3 # Array form->number->array form version
4 #
5 # See https://wlmb.github.io/2025/10/20/PWC344/#task-1-array-form-compute
6 use v5.36;
7 use feature qw(try);
8 use PDL;
9 die <<~"FIN" unless @ARGV && @ARGV%2==0;
10 Usage: $0 A0 I0 A1 I1...
11 to add the integer Ij to the integer in array form An
12 and print the array form of the result.
13 FIN
14 for my($string, $integer)(@ARGV){
15 try {
16 die "Input should be space separated positive integers within square brackets: $string"
17 unless $string =~ /^\[(\d|\s)*]$/;
18 die "Input should be a positive integer" unless $integer=~/^\d+$/;
19 my $array=pdl($string);
20 my $number=($array*10**($array->nelem-1-$array->xvals))->sumover+$integer;
21 my $result=pdl([split "", $number]);
22 say "$string, $number -> $result";
23 }
24 catch($e){ warn $e;}
25 }
Examples:
./ch-1.pl "[1 2 3 4]" 12 "[2 7 4]" 181 "[9 9 9]" 1 "[1 0 0 0 0]" 9999 "[0]" 1000
Results:
[1 2 3 4], 1246 -> [1 2 4 6]
[2 7 4], 455 -> [4 5 5]
[9 9 9], 1000 -> [1 0 0 0]
[1 0 0 0 0], 19999 -> [1 9 9 9 9]
[0], 1000 -> [1 0 0 0]
Number -> array form
The opposite, slightly more complex approach is to convert the integer to array form and sum the array forms. Here I use PDL only to interpret the input, and for some functions, but work digit by digit using Perl arrays. The result is a three-liner.
Examples:
perl -MPDL -E '
for my($x, $y)(@ARGV){@p=pdl($x)->list;@q=split "", $y;@r=();$c=0;
while(@p||@q){$s=((pop @p)//0)+((pop @q)//0)+$c;$c=floor($s/10);
unshift @r, $s%10;}unshift @r, $c if $c;say "$x, $y -> [@r]";}
' "[1 2 3 4]" 12 "[2 7 4]" 181 "[9 9 9]" 1 "[1 0 0 0 0]" 9999 "[0]" 1000
Results:
[1 2 3 4], 12 -> [1 2 4 6]
[2 7 4], 181 -> [4 5 5]
[9 9 9], 1 -> [1 0 0 0]
[1 0 0 0 0], 9999 -> [1 9 9 9 9]
[0], 1000 -> [1 0 0 0]
The corresponding full code is:
1 # Perl weekly challenge 344
2 # Task 1: Array Form Compute
3 # Number -> array form version
4 #
5 # See https://wlmb.github.io/2025/10/20/PWC344/#task-1-array-form-compute
6 use v5.36;
7 use feature qw(try);
8 use PDL;
9 die <<~"FIN" unless @ARGV && @ARGV%2==0;
10 Usage: $0 A0 I0 A1 I1...
11 to add the integer Ij to the integer in array form An
12 and print the array form of the result.
13 FIN
14 for my($string, $integer)(@ARGV){
15 try {
16 die "Input should be space separated positive integers within square brackets: $string"
17 unless $string =~ /^\[(\d|\s)*]$/;
18 die "Input should be a positive integer" unless $integer=~/^\d+$/;
19 my @array=pdl($string)->list;
20 my @other=split "", $integer;
21 my @result=();
22 my $carry=0;
23 while(@array||@other){
24 my $sum=((pop @array)//0)+((pop @other)//0)+$carry;
25 $carry=floor($sum/10);
26 unshift @result, $sum%10;
27 }
28 unshift @result, $carry if $carry;
29 say "$string, $integer -> [@result]";
30 }
31 catch($e){ warn $e;}
32 }
Examples:
./ch-1a.pl "[1 2 3 4]" 12 "[2 7 4]" 181 "[9 9 9]" 1 "[1 0 0 0 0]" 9999 "[0]" 1000
Results:
[1 2 3 4], 12 -> [1 2 4 6]
[2 7 4], 181 -> [4 5 5]
[9 9 9], 1 -> [1 0 0 0]
[1 0 0 0 0], 9999 -> [1 9 9 9 9]
[0], 1000 -> [1 0 0 0]
Task 2: Array Formation
Submitted by: Mohammad Sajid Anwar
You are given two list: @source and @target.
Write a script to see if you can build the exact @target by putting these smaller
lists from @source together in some order. You cannot break apart or change the
order inside any of the smaller lists in @source.
Example 1
Input: @source = ([2,3], [1], [4])
@target = (1, 2, 3, 4)
Output: true
Use in the order: [1], [2,3], [4]
Example 2
Input: @source = ([1,3], [2,4])
@target = (1, 2, 3, 4)
Output: false
Example 3
Input: @source = ([9,1], [5,8], [2])
@target = (5, 8, 2, 9, 1)
Output: true
Use in the order: [5,8], [2], [9,1]
Example 4
Input: @source = ([1], [3])
@target = (1, 2, 3)
Output: false
Missing number: 2
Example 5
Input: @source = ([7,4,6])
@target = (7, 4, 6)
Output: true
Use in the order: [7, 4, 6]
All permutations
A simple inefficient solution can be obtained by producing all
permutations of the source arrays and comparing them to the target
until one matches are none does. I may use the permutations
iterator from Algorithm::Combinatorics
and the Perl Data Language
(PDL) to operate on arrays. The result fits a three-liner.
Examples:
perl -MAlgorithm::Combinatorics=permutations -MPDL -E '
L: for my($s,$t)(@ARGV){@s=map{pdl($_)}split/\s*,\s*/,$s;$u=pdl($t);$r=0;next
unless $u->nelem==pdl(map{$_->nelem}@s)->sum;$p=permutations(\@s);while($n=$p->next){
$r=1, next L if all(PDL::glue(0,@$n)==$u)}}continue{say "$s; $t -> ", $r?T:F;}
' "[2 3],[1],[4]" "[1 2 3 4]" "[1 3],[2 4]" "[1 2 3 4]" "[9 1],[5 8],[2]" "[5 8 2 9 1]" \
"[1], [3]" "[1 2 3]" "[7 4 6]" "[7 4 6]"
Results:
[2 3],[1],[4]; [1 2 3 4] -> T
[1 3],[2 4]; [1 2 3 4] -> F
[9 1],[5 8],[2]; [5 8 2 9 1] -> T
[1], [3]; [1 2 3] -> F
[7 4 6]; [7 4 6] -> T
Recursive solution
For the full code I program a recursive solution in which I test in turn each of the sources candidates and if it matches the initial part of the target, I test the rest of the source on the rest of the target. Thus, I can discard some permutations early and I don’t have to generate all.
1 # Perl weekly challenge 344
2 # Task 2: Array Formation
3 #
4 # See https://wlmb.github.io/2025/10/20/PWC344/#task-2-array-formation
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 use PDL::NiceSlice;
9 die <<~"FIN" unless @ARGV && @ARGV%2==0;
10 Usage: $0 S0 T0 S1 T1...
11 to match the source arrays Si to the target array Ti.
12 The sources are comma separated strings of the form "s0, s1..." where
13 each string contains an array of space separated numbers within square brackets
14 of the form "[n0 n1...]"
15 FIN
16 my $result;
17 for my($sources, $target)(@ARGV){
18 try {
19 my @sources = map {pdl($_)} split /\s*,\s*/, $sources;
20 my $ptarget = pdl($target);
21 do{die "Expected 1D arrays of numbers: $_" unless $_->ndims==1;} for @sources, $ptarget;
22 $result=0, next unless pdl(map{$_->nelem} @sources)->sum == $ptarget->nelem;
23 my @tested=();
24 while(@sources){
25 $result = test([@tested],[@sources],$ptarget) and last;
26 push @tested, shift @sources;
27 }
28 }
29 catch($e){ warn $e; }
30 }
31 continue{
32 say "$sources, $target -> ", $result?"True":"False";
33 }
34 sub test($tested, $untested, $target){
35 my @tested=@$tested;
36 my @untested=@$untested;
37 return 1 unless @untested;
38 while(@untested){
39 my $current=shift @untested;
40 my $result=all($current==$target(0:$current->nelem-1)); # assume target is large enough
41 $result=test([], [@tested, @untested], $target($current->nelem:-1)) if $result;
42 return 1 if $result;
43 push @tested, $current;
44 }
45 return 0;
46 }
Example:
./ch-2.pl "[2 3],[1],[4]" "[1 2 3 4]" \
"[1 3],[2 4]" "[1 2 3 4]" \
"[9 1],[5 8],[2]" "[5 8 2 9 1]" \
"[1], [3]" "[1 2 3]" \
"[7 4 6]" "[7 4 6]"
Results:
[2 3],[1],[4], [1 2 3 4] -> True
[1 3],[2 4], [1 2 3 4] -> False
[9 1],[5 8],[2], [5 8 2 9 1] -> True
[1], [3], [1 2 3] -> False
[7 4 6], [7 4 6] -> True
/;