```
Submitted by: Mohammad Sajid Anwar
You are given a m x n binary matrix.
Write a script to return the number of special positions in the given binary matrix.
A position (i, j) is called special if $matrix[i][j] == 1 and all other elements in
the row i and column j are 0.
Example 1
Input: $matrix = [ [1, 0, 0],
[0, 0, 1],
[1, 0, 0],
]
Output: 1
There is only one special position (1, 2) as $matrix[1][2] == 1
and all other elements in row 1 and column 2 are 0.
Example 2
Input: $matrix = [ [1, 0, 0],
[0, 1, 0],
[0, 0, 1],
]
Output: 3
Special positions are (0,0), (1, 1) and (2,2).
```

On a special row the binary `or`

of all the bits should be the number 1 (only 0’s or
1’s, at least one 1) and the sum of all the elements should also be 1
(at most one 1). The same
for a special column. The special positions have the value 1 and are
in a special row and a special column. After building a matrix with
1’s only at special positions, I just add them. Using the ```
Perl Data
Language
```

(PDL), this may be coded in a two liner:

Example 1:

```
perl -MPDL -E '
$x=pdl(shift);say "$x -> ",(($x)&(($x->borover==1)->dummy(0))&(($x->transpose->borover==1)->dummy(1))
&(($x->sumover==1)->dummy(0))&(($x->transpose->sumover==1)->dummy(1)))->sum
' "[[1 0 0][0 0 1][1 0 0]]"
```

Results:

```
[
[1 0 0]
[0 0 1]
[1 0 0]
]
-> 1
```

Example 2:

```
perl -MPDL -E '
$x=pdl(shift);say "$x -> ",(($x)&(($x->borover==1)->dummy(0))&(($x->transpose->borover==1)->dummy(1))
&(($x->sumover==1)->dummy(0))&(($x->transpose->sumover==1)->dummy(1)))->sum
' "[[1 0 0][0 1 0][0 0 1]]"
```

Results:

```
[
[1 0 0]
[0 1 0]
[0 0 1]
]
-> 3
```

The full code follows

```
1 # Perl weekly challenge 270
2 # Task 1: Special Positions
3 #
4 # See https://wlmb.github.io/2024/05/20/PWC270/#task-1-special-positions
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 M1 M2...
9 where M1, M2... are strings that represent matrices, of the form
10 "[[m11 m12...][m21 m22...]...]"
11 FIN
12 for(@ARGV){
13 my $x=pdl($_);
14 say "$x -> ",
15 (($x) # value is not zero
16 &(($x->borover==1)->dummy(0)) # only 0's and 1's in row
17 &(($x->transpose->borover==1)->dummy(1)) # only 0's and 1's in column
18 &(($x->sumover==1)->dummy(0)) # only one 1 in row
19 &(($x->transpose->sumover==1)->dummy(1)) # only one 1 in column
20 )->sum;
21 }
```

Examples:

```
./ch-1.pl "[[1 0 0][0 0 1][1 0 0]]" "[[1 0 0][0 1 0][0 0 1]]"
```

Results:

```
[
[1 0 0]
[0 0 1]
[1 0 0]
]
-> 1
[
[1 0 0]
[0 1 0]
[0 0 1]
]
-> 3
```

```
Submitted by: Mohammad Sajid Anwar
You are give an array of integers, @ints and two integers, $x and $y.
Write a script to execute one of the two options:
Level 1:
Pick an index i of the given array and do $ints[i] += 1
Level 2:
Pick two different indices i,j and do $ints[i] +=1 and $ints[j] += 1.
You are allowed to perform as many levels as you want to make every elements
in the given array equal. There is cost attach for each level, for Level 1,
the cost is $x and $y for Level 2.
In the end return the minimum cost to get the work done.
Example 1
Input: @ints = (4, 1), $x = 3 and $y = 2
Output: 9
Level 1: i=1, so $ints[1] += 1.
@ints = (4, 2)
Level 1: i=1, so $ints[1] += 1.
@ints = (4, 3)
Level 1: i=1, so $ints[1] += 1.
@ints = (4, 4)
We perforned operation Level 1, 3 times.
So the total cost would be 3 x $x => 3 x 3 => 9
Example 2
Input: @ints = (2, 3, 3, 3, 5), $x = 2 and $y = 1
Output: 6
Level 2: i=0, j=1, so $ints[0] += 1 and $ints[1] += 1
@ints = (3, 4, 3, 3, 5)
Level 2: i=0, j=2, so $ints[0] += 1 and $ints[2] += 1
@ints = (4, 4, 4, 3, 5)
Level 2: i=0, j=3, so $ints[0] += 1 and $ints[3] += 1
@ints = (5, 4, 4, 4, 5)
Level 2: i=1, j=2, so $ints[1] += 1 and $ints[2] += 1
@ints = (5, 5, 5, 4, 5)
Level 1: i=3, so $ints[3] += 1
@ints = (5, 5, 5, 5, 5)
We perforned operation Level 1, 1 time and Level 2, 4 times.
So the total cost would be (1 x $x) + (4 x $y) => (1 x 2) + (4 x 1) => 6
```

(Note: I corrected a typo in the example above).

The final value of all elements is the maximum of the original
array. If a level 2 is possible, it is preferable unless it is more
expensive than two level 1 steps. I can sort the elements in
descending order, so it is safe to make a level 2 with the remaining
largest and next largest elements as many times as
necessary to make the first element as large as the maximum. It is not
necessary to perform the steps one at a time to calculate the
number of steps and their cost. Then I can shift the array and start over
again until I empty the array. If there are no further elements or if level 2 is too
expensive, I do level 1 steps. I take `$x`

, `$y`

and `@ints`

from
`@ARGV`

The result fits a two liner.

Example 1:

```
perl -E '
($x, $y)=(shift,shift);$t=$y<2*$x;@p=sort{$b<=>$a}@ARGV;$m=shift @p;while(@p){$s=$m-shift @p;
if($t&&@p){$p[0]+=$s;$c+=$s*$y}else{$c+=$s*$x}} say "x=$x, y=$y, ints= @ARGV -> $c"
' 3 2 4 1
```

Results:

```
x=3, y=2, ints= 4 1 -> 9
```

Example 2:

```
perl -E '
($x, $y)=(shift,shift);$t=$y<2*$x;@p=sort{$b<=>$a}@ARGV;$m=shift @p;while(@p){$s=$m-shift @p;
if($t&&@p){$p[0]+=$s;$c+=$s*$y}else{$c+=$s*$x}} say "x=$x, y=$y, ints= @ARGV -> $c"
' 2 1 2 3 3 3 5
```

Results:

```
x=2, y=1, ints= 2 3 3 3 5 -> 6
```

The full code is:

```
1 # Perl weekly challenge 270
2 # Task 2: Distribute Elements
3 #
4 # See https://wlmb.github.io/2024/05/20/PWC270/#task-2-distribute-elements
5 use v5.36;
6 die <<~"FIN" unless @ARGV >= 2;
7 Usage: $0 X Y A1 A2...
8 to find the minimum cost of maeking all elements of the array A1 A2... equal
9 by adding 1 to individual elements, with cost X or adding 1 to pairs of
10 elements with cost Y.
11 FIN
12 my ($x, $y)=(shift,shift);
13 my $prefer_two=$y<2*$x;
14 my @decreasing = sort {$b<=>$a} @ARGV;
15 my $max = shift @decreasing;
16 my $total = 0;
17 while(@decreasing){
18 my $steps = $max - shift @decreasing;
19 if($prefer_two && @decreasing){ # Can I do level 2?
20 $decreasing[0] += $steps; # Update next element
21 $total += $steps * $y; # Update total cost
22 }else{ # level 1 instead
23 $total += $steps * $x; # Update total cost
24 }
25 }
26 say "x=$x, y=$y, ints= @ARGV -> $total"
```

Example:

```
./ch-2.pl 3 2 4 1
./ch-2.pl 2 1 2 3 3 3 5
```

Results:

```
x=3, y=2, ints= 4 1 -> 9
x=2, y=1, ints= 2 3 3 3 5 -> 6
```

I try a couple of tricky examples by Choroba:

```
./ch-2.pl 6 10 2 3 5 1 2 1 1 7
./ch-2.pl 4 1 1 2 2 2 2
```

Results:

```
x=6, y=10, ints= 2 3 5 1 2 1 1 7 -> 174
x=4, y=1, ints= 1 2 2 2 2 -> 4
```

I realize that my assumption that the maximum is the common value to
attain *is wrong*. The last example could have been solved with 3
level 2 steps if the final common value were incremented to 3.
It seems that the problem is that I leave the smallest value at the
end, which might require some expensive level 1 steps ata the end. Thus I propose
a slightly more complex approach, in which I perform a level 2 step on
the smallest values and retry the cost calculation, until the total
cost increases. The program (below) is slightly more complex (and not
very well organized nor optimized).

```
1 # Perl weekly challenge 270
2 # Task 2: Distribute Elements
3 #
4 # See https://wlmb.github.io/2024/05/20/PWC270/#task-2-distribute-elements
5 use v5.36;
6 die <<~"FIN" unless @ARGV >= 2;
7 Usage: $0 X Y A1 A2...
8 to find the minimum cost of maeking all elements of the array A1 A2... equal
9 by adding 1 to individual elements, with cost X or adding 1 to pairs of
10 elements with cost Y.
11 FIN
12 my ($x, $y)=(shift,shift);
13 my $prefer_two=$y<2*$x;
14 my @decreasing = sort {$b<=>$a} @ARGV;
15 my $oldtotal = my $total = cost(@decreasing);
16 my $precost=0;
17 while(1){
18 ++$decreasing[-1]; # perform level 2 on smallest elements
19 ++$decreasing[-2];
20 $precost += $y; # add cost
21 @decreasing=sort {$b<=>$a} @decreasing; # sort again :(
22 $total=$precost+cost(@decreasing);
23 last if $total > $oldtotal; # finish when there is no gain
24 $oldtotal=$total;
25 }
26 say "x=$x, y=$y, ints= @ARGV -> $oldtotal";
27
28 sub cost(@decreasing){
29 my $max =shift @decreasing;
30 my $total=0;
31 while(@decreasing){
32 my $steps = $max - shift @decreasing;
33 if($prefer_two && @decreasing){ # Can I do level 2?
34 $decreasing[0] += $steps; # Update next element
35 $total += $steps * $y; # Update total cost
36 }else{ # level 1 instead
37 $total += $steps * $x; # Update total cost
38 }
39 }
40 return $total;
41 }
./ch-2a.pl 3 2 4 1
./ch-2a.pl 2 1 2 3 3 3 5
./ch-2a.pl 6 10 2 3 5 1 2 1 1 7
./ch-2a.pl 4 1 1 2 2 2 2
```

Results:

```
x=3, y=2, ints= 4 1 -> 9
x=2, y=1, ints= 2 3 3 3 5 -> 6
x=6, y=10, ints= 2 3 5 1 2 1 1 7 -> 170
x=4, y=1, ints= 1 2 2 2 2 -> 3
```

Notice that I obtained better results for the last two examples than with my previous program. In this case, I believe they are optimal, though I’m not sure the new program finds always the optimal solution.

]]>```
Submitted by: Mohammad Sajid Anwar
You are given an array of positive integers, @ints.
Write a script to find out if it is possible to select two or more elements
of the given array such that the bitwise OR of the selected elements has at
least one trailing zero in its binary representation.
Example 1
Input: @ints = (1, 2, 3, 4, 5)
Output: true
Say, we pick 2 and 4, thier bitwise OR is 6. The binary representation of 6 is 110.
Return true since we have one trailing zero.
Example 2
Input: @ints = (2, 3, 8, 16)
Output: true
Say, we pick 2 and 8, thier bitwise OR is 10. The binary representation of 10 is 1010.
Return true since we have one trailing zero.
Example 3
Input: @ints = (1, 2, 5, 7, 9)
Output: false
```

The answer is true if I have two or more even numbers in the array. I
can `grep`

them and count them, which yields a half-liner.

Example 1:

```
perl -E 'say "@ARGV -> ", (@x=grep {($_&1)==0} @ARGV)>=2?"True":"False"; ' 1 2 3 4 5
```

Results:

```
1 2 3 4 5 -> True
```

Example 2:

```
perl -E 'say "@ARGV -> ", (@x=grep {($_&1)==0} @ARGV)>=2?"True":"False"; ' 2 3 8 16
```

Results:

```
2 3 8 16 -> True
```

Output: true

Example 3:

```
perl -E 'say "@ARGV -> ", (@x=grep {($_&1)==0} @ARGV)>=2?"True":"False"; ' 1 2 5 7 9
```

Results:

```
1 2 5 7 9 -> False
1 # Perl weekly challenge 269
2 # Task 1: Bitwise OR
3 #
4 # See https://wlmb.github.io/2024/05/13/PWC269/#task-1-bitwise-or
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 N2...
8 to find if there are two or more numbers Ni whose bitwise
9 or has the zeroth bit turned off.
10 FIN
11 say "@ARGV -> ", (my @x=grep {($_&1)==0} @ARGV)>=2?"True":"False";
```

Examples:

```
./ch-1.pl 1 2 3 4 5
./ch-1.pl 2 3 8 16
./ch-1.pl 1 2 5 7 9
```

Results:

```
1 2 3 4 5 -> True
2 3 8 16 -> True
1 2 5 7 9 -> False
```

```
Submitted by: Mohammad Sajid Anwar
You are given an array of distinct integers, @ints.
Write a script to distribute the elements as described below:
1. Put the 1st element of the given array to a new array @arr1.
2. Put the 2nd element of the given array to a new array @arr2.
Once you have one element in each arrays, @arr1 and @arr2, then follow the rule below:
If the last element of the array @arr1 is greater than the last
element of the array @arr2 then add the first element of the
given array to @arr1 otherwise to the array @arr2.
When done distribution, return the concatenated arrays. @arr1 and @arr2.
Example 1
Input: @ints = (2, 1, 3, 4, 5)
Output: (2, 3, 4, 5, 1)
1st operation:
Add 1 to @arr1 = (2)
2nd operation:
Add 2 to @arr2 = (1)
3rd operation:
Now the last element of @arr1 is greater than the last element
of @arr2, add 3 to @arr1 = (2, 3).
4th operation:
Again the last element of @arr1 is greate than the last element
of @arr2, add 4 to @arr1 = (2, 3, 4)
5th operation:
Finally, the last element of @arr1 is again greater than the last
element of @arr2, add 5 to @arr1 = (2, 3, 4, 5)
Mow we have two arrays:
@arr1 = (2, 3, 4, 5)
@arr2 = (1)
Concatenate the two arrays and return the final array: (2, 3, 4, 5, 1).
Example 2
Input: @ints = (3, 2, 4)
Output: (3, 4, 2)
1st operation:
Add 1 to @arr1 = (3)
2nd operation:
Add 2 to @arr2 = (2)
3rd operation:
Now the last element of @arr1 is greater than the last element
of @arr2, add 4 to @arr1 = (3, 4).
Mow we have two arrays:
@arr1 = (3, 4)
@arr2 = (2)
Concatenate the two arrays and return the final array: (3, 4, 2).
Example 3
Input: @ints = (5, 4, 3 ,8)
Output: (5, 3, 4, 8)
1st operation:
Add 1 to @arr1 = (5)
2nd operation:
Add 2 to @arr2 = (4)
3rd operation:
Now the last element of @arr1 is greater than the last element
of @arr2, add 3 to @arr1 = (5, 3).
4th operation:
Again the last element of @arr2 is greate than the last element
of @arr1, add 8 to @arr2 = (4, 8)
Mow we have two arrays:
@arr1 = (5, 3)
@arr2 = (4, 8)
Concatenate the two arrays and return the final array: (5, 3, 4, 8).
```

I simply follow the instructions. I use a reference to the array to which I should push the following element. This yields a one-liner.

Example 1:

```
perl -E '
@x=@ARGV;($y[0],$z[0])=(shift,shift);for(@ARGV){$l=$y[-1]>$z[-1]?\@y:\@z;push @$l,$_}say "@x->@y @z";
' 2 1 3 4 5
```

Results:

```
2 1 3 4 5->2 3 4 5 1
perl -E '
@x=@ARGV;($y[0],$z[0])=(shift,shift);for(@ARGV){$l=$y[-1]>$z[-1]?\@y:\@z;push @$l,$_}say "@x->@y @z";
' 3 2 4
```

Results:

```
3 2 4->3 4 2
```

Example 3:

```
perl -E '
@x=@ARGV;($y[0],$z[0])=(shift,shift);for(@ARGV){$l=$y[-1]>$z[-1]?\@y:\@z;push @$l,$_}say "@x->@y @z";
' 5 4 3 8
```

Results:

```
5 4 3 8->5 3 4 8
```

The full code follows:

```
1 # Perl weekly challenge 269
2 # Task 2: Distribute Elements
3 #
4 # See https://wlmb.github.io/2024/05/13/PWC269/#task-2-distribute-elements
5 use v5.36;
6 die <<~"FIN" unless @ARGV>=2;
7 Usage: $0 N1 N2...
8 to redistribute the numbers N1 N2...
9 FIN
10 my @in=@ARGV;
11 my @y=(shift);
12 my @z=(shift);
13 for(@ARGV){
14 my $which=$y[-1]>$z[-1]?\@y:\@z;
15 push @$which,$_;
16 }
17 say "@in->@y @z";
```

Examples:

```
./ch-2.pl 2 1 3 4 5
./ch-2.pl 3 2 4
./ch-2.pl 5 4 3 8
```

Results:

```
2 1 3 4 5->2 3 4 5 1
3 2 4->3 4 2
5 4 3 8->5 3 4 8
```

```
Submitted by: Mohammad Sajid Anwar
You are given two arrays of integers of same size, @x and @y.
Write a script to find the magic number that when added to each elements of one
of the array gives the second array. Elements order is not important.
Example 1
Input: @x = (3, 7, 5)
@y = (9, 5, 7)
Output: 2
The magic number is 2.
@x = (3, 7, 5)
+ 2 2 2
@y = (5, 9, 7)
Example 2
Input: @x = (1, 2, 1)
@y = (5, 4, 4)
Output: 3
The magic number is 3.
@x = (1, 2, 1)
+ 3 3 3
@y = (5, 4, 4)
Example 3
Input: @x = (2)
@y = (5)
Output: 3
```

The simplest solution is to take the difference between the maxima or the minima of the arrays, as it should equal the difference between the second largest or second smaller elements, the third largest or the third smallest, etc.

Example 1:

```
perl -MList::Util=min -E '
($x,$y)=map {min split " "} @ARGV; say "($ARGV[0]),($ARGV[1])->",$y-$x
' "3 7 5" "9 5 7"
```

Results:

```
(3 7 5),(9 5 7)->2
```

Example 2:

```
perl -MList::Util=min -E '
($x,$y)=map {min split " "} @ARGV; say "($ARGV[0]),($ARGV[1])->",$y-$x
' "1 2 1" "5 4 4"
```

Results:

```
(1 2 1),(5 4 4)->3
```

Example 3:

```
perl -MList::Util=min -E '
($x,$y)=map {min split " "} @ARGV; say "($ARGV[0]),($ARGV[1])->",$y-$x
' 2 5
```

Results:

```
(2),(5)->3
```

The problem is that there might be no magic number, so a test should
be performed. The simplest solution would then be to sort the arrays,
run-length encode their difference and checking there is only one
distinct value. This may be done with the `Perl Data Language PDL`

Example 1:

```
perl -MPDL -E '
($x,$y)=map{pdl $_}@ARGV;($r,$v)=($y->qsort-$x->qsort)->rle; say "@ARGV -> ", $v->dim(0)==1?$v:"None"
' "[3 7 5]" "[9 5 7]"
```

Results:

```
[3 7 5] [9 5 7] -> [2]
```

Example 2:

```
perl -MPDL -E '
($x,$y)=map{pdl $_}@ARGV;($r,$v)=($y->qsort-$x->qsort)->rle; say "@ARGV -> ", $v->dim(0)==1?$v:"None"
' "[1 2 1]" "[5 4 4]"
```

Results:

```
[1 2 1] [5 4 4] -> [3]
```

Example 3:

```
perl -MPDL -E '
($x,$y)=map{pdl $_}@ARGV;($r,$v)=($y->qsort-$x->qsort)->rle; say "@ARGV -> ", $v->dim(0)==1?$v:"None"
' "[2]" "[5]"
```

Results:

```
2 5 -> [3]
```

Example with inconsistent data:

```
perl -MPDL -E '
($x,$y)=map{pdl $_}@ARGV;($r,$v)=($y->qsort-$x->qsort)->rle; say "@ARGV -> ", $v->dim(0)==1?$v:"None"
' "[3 7 5]" "[9 5 8]"
```

Results:

```
[3 7 5] [9 5 8] -> None
```

Full code:

```
1 # Perl weekly challenge 268
2 # Task 1: Magic Number
3 #
4 # See https://wlmb.github.io/2024/05/06/PWC268/#task-1-magic-number
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV==2;
8 Usage: $0 X Y
9 where X is "[x1 x2...]" and Y=[y1 y2...]
10 to find the magic number M which added to the elements
11 of X yields the elements of Y
12 FIN
13 my ($x,$y)=map{pdl $_}@ARGV;
14 my (undef, $values)=($y->qsort-$x->qsort)->rle;
15 say "@ARGV -> ", $values->dim(0)==1?$values:"None"
```

Examples:

```
./ch-1.pl "[3 7 5]" "[9 5 7]"
./ch-1.pl "[1 2 1]" "[5 4 4]"
./ch-1.pl "[2]" "[5]"
./ch-1.pl "[3 7 5]" "[9 5 8]"
```

Results:

```
[3 7 5] [9 5 7] -> [2]
[1 2 1] [5 4 4] -> [3]
[2] [5] -> [3]
[3 7 5] [9 5 8] -> None
```

```
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints, with even number of elements.
Write a script to create a new array made up of elements of the given array. Pick the two smallest integers and add it to new array in decreasing order i.e. high to low. Keep doing until the given array is empty.
Example 1
Input: @ints = (2, 5, 3, 4)
Output: (3, 2, 5, 4)
Round 1: we picked (2, 3) and push it to the new array (3, 2)
Round 2: we picked the remaining (4, 5) and push it to the new array (5, 4)
Example 2
Input: @ints = (9, 4, 1, 3, 6, 4, 6, 1)
Output: (1, 1, 4, 3, 6, 4, 9, 6)
Example 3
Input: @ints = (1, 2, 2, 3)
Output: (2, 1, 3, 2)
```

This is easily solved by sorting the array in ascending order and
looking at the elements two at a time using the new `for_list`

and
sorting them in descending order.

Example 1:

```
perl -Mexperimental=for_list -E '
for my($x, $y)(sort {$a<=>$b} @ARGV){push @r, sort{$b<=>$a}($x,$y)} say "@ARGV -> @r";
' 2 5 3 4
```

Results:

```
2 5 3 4 -> 3 2 5 4
```

Example 2:

```
perl -Mexperimental=for_list -E '
for my($x, $y)(sort {$a<=>$b} @ARGV){push @r, sort{$b<=>$a}($x,$y)} say "@ARGV -> @r";
' 9 4 1 3 6 4 6 1
```

Results:

```
9 4 1 3 6 4 6 1 -> 1 1 4 3 6 4 9 6
```

Example 3:

```
perl -Mexperimental=for_list -E '
for my($x, $y)(sort {$a<=>$b} @ARGV){push @r, sort{$b<=>$a}($x,$y)} say "@ARGV -> @r";
' 1 2 2 3
```

Results:

```
1 2 2 3 -> 2 1 3 2
```

Full code:

```
1 # Perl weekly challenge 268
2 # Task 2: Number Game
3 #
4 # See https://wlmb.github.io/2024/05/06/PWC268/#task-2-number-game
5 use v5.36;
6 use experimental qw(for_list);
7 die <<~"FIN" unless @ARGV and @ARGV%2==0;
8 Usage: $0 N1 N2... N2m
9 to print array even sized array N1..N2m in zig-zag order
10 (decreasing pairs of increasing value)
11 FIN
12 my @result;
13 for my($x, $y)(sort {$a<=>$b} @ARGV){
14 push @result, sort{$b<=>$a}($x,$y)
15 }
16 say "@ARGV -> @result";
```

Examples:

```
./ch-2.pl 2 5 3 4
./ch-2.pl 9 4 1 3 6 4 6 1
./ch-2.pl 1 2 2 3
```

Results:

```
2 5 3 4 -> 3 2 5 4
9 4 1 3 6 4 6 1 -> 1 1 4 3 6 4 9 6
1 2 2 3 -> 2 1 3 2
```

```
Submitted by: Mohammad Sajid Anwar
You are given an array of @ints.
Write a script to find the sign of product of all integers in the given array.
The sign is 1 if the product is positive, -1 if the product is negative and 0
if product is zero.
Example 1
Input: @ints = (-1, -2, -3, -4, 3, 2, 1)
Output: 1
The product -1 x -2 x -3 x -4 x 3 x 2 x 1 => 144 > 0
Example 2
Input: @ints = (1, 2, 0, -2, -1)
Output: 0
The product 1 x 2 x 0 x -2 x -1 => 0
Example 3
Input: @ints = (-1, -1, 1, -1, 2)
Output: -1
The product -1 x -1 x 1 x -1 x 2 => -2 < 0
```

A simple solution is to apply a three way comparison `<=>`

of the
`product`

(from `List::Utils`

) with 0. This yields a half-liner:
Example 1:

```
perl -MList::Util=product -E 'say "@ARGV -> ", product(@ARGV) <=> 0' -- -1 -2 -3 -4 3 2 1
```

Results:

```
-1 -2 -3 -4 3 2 1 -> 1
```

Example 2:

```
perl -MList::Util=product -E 'say "@ARGV -> ", product(@ARGV) <=> 0' -- 1 2 0 -2 -1
```

Results:

```
1 2 0 -2 -1 -> 0
```

Example 3:

```
perl -MList::Util=product -E 'say "@ARGV -> ", product(@ARGV) <=> 0' -- -1 -1 1 -1 2
```

Results:

```
-1 -1 1 -1 2 -> -1
```

A similar program may be built with PDL:

Examples:

```
perl -MPDL -E 'for(@ARGV){$x=pdl($_); say "$x -> ", $x->prodover<=>0}
' -- "-1 -2 -3 -4 3 2 1" "1 2 0 -2 -1" "-1 -1 1 -1 2"
```

Results:

```
[-1 -2 -3 -4 3 2 1] -> 1
[1 2 0 -2 -1] -> 0
[-1 -1 1 -1 2] -> -1
```

The full code is almost identical.

```
1 # Perl weekly challenge 267
2 # Task 1: Product Sign
3 #
4 # See https://wlmb.github.io/2024/04/29/PWC267/#task-1-product-sign
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 "x0 ẍ1..." ¨"y0 y1..." ...
9 to find the sign of the products x0 x1..., y0 y1..., etc.
10 FIN
11 for(@ARGV){
12 my $x=pdl($_);
13 say "$x -> ", $x->prodover<=>0;
14 }
```

Examples:

```
./ch-1.pl "-1 -2 -3 -4 3 2 1" "1 2 0 -2 -1" "-1 -1 1 -1 2"
```

Results:

```
[-1 -2 -3 -4 3 2 1] -> 1
[1 2 0 -2 -1] -> 0
[-1 -1 1 -1 2] -> -1
```

Using the flexibility of PDL, I can use the code above to get the sign of the products of all the rows of a matrix, or of an n dimensional array.

Example:

```
./ch-1.pl "[[1 2 3][-1 0 1][-3 -2 -1]]"
```

Results:

```
[
[ 1 2 3]
[-1 0 1]
[-3 -2 -1]
]
-> [1 0 -1]
```

```
Submitted by: Mohammad Sajid Anwar
You are given a string, $str, and a 26-items array @widths containing
the width of each character from a to z.
Write a script to find out the number of lines and the width of the
last line needed to display the given string, assuming you can only
fit 100 width units on a line.
Example 1
Input: $str = "abcdefghijklmnopqrstuvwxyz"
@widths = (10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,
10,10,10,10,10,10,10,10,10)
Output: (3, 60)
Line 1: abcdefghij (100 pixels)
Line 2: klmnopqrst (100 pixels)
Line 3: uvwxyz (60 pixels)
Example 2
Input: $str = "bbbcccdddaaa"
@widths = (4,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,
10,10,10,10,10,10,10,10,10)
Output: (2, 4)
Line 1: bbbcccdddaa (98 pixels)
Line 2: a (4 pixels)
```

I guess the simplest solution is to add characters one by one
incrementing a horizontal counter, until it overflows, in which case,
it is reset and a vertical counter is incremented. At the end, both
counters are reported. Characters may be mapped to array indices by
subtracting `ord("a")`

. There are some edge cases to check: If the
last line is exactly 100 pixels long, should a new empty line be
started or should we wait for an actual overflow to start the next
line. I guess the former criteria is to be expected, though it is
slightly more complex. The result fits a two-liner.

Example 1:

```
perl -E '$l=1;$p=100;$a=shift;@w=@ARGV;@s=map {$w[ord($_)-ord("a")]} split "", $a;
for(@s){$c+=$_;$c=$_,$l++ if $c>$p;$c=0,$l++ if $c==$p}say "$a\n@w\n-> ($l, $c)";
' "abcdefghijklmnopqrstuvwxyz" \
10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
```

Results:

```
abcdefghijklmnopqrstuvwxyz
10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
-> (3, 60)
```

Example 2:

```
perl -E '$l=1;$p=100;$a=shift;@w=@ARGV;@s=map {$w[ord($_)-ord("a")]} split "", $a;
for(@s){$c+=$_;$c=$_,$l++ if $c>$p;$c=0,$l++ if $c==$p}say "$a\n@w\n-> ($l, $c)";
' "bbbcccdddaaa"\
4 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
```

Results:

```
bbbcccdddaaa
4 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
-> (2, 4)
```

The full code follows:

```
1 # Perl weekly challenge 267
2 # Task 2: Line Counts
3 #
4 # See https://wlmb.github.io/2024/04/29/PWC267/#task-2-line-counts
5 use v5.36;
6 die <<~"FIN" unless @ARGV==27;
7 Usage: $0 S W1 W2...W26
8 to find how many lines and additional characters are needed to print
9 the string S given the widths W1, W2..W26 of the letters a, b...z.
10 FIN
11
12 my $line_width=100;
13 my $string=shift;
14 my @widths_ord=@ARGV;
15 my @widths_string=map {$widths_ord[ord($_)-ord("a")]} split "", $string;
16 my $current_line=1; # Note that I report one line, 0 chars for an empty string!
17 my $current_column = 0; # current column
18 for(@widths_string){
19 $current_column += $_;
20 $current_column = $_, ++$current_line if $current_column > $line_width;
21 $current_column = 0, ++$current_line if $current_column == $line_width;
22
23 }
24 say "string=$string\nwidths=\n\t@widths_ord[0..9]\n\t@widths_ord[10..19]",
25 "\n\t@widths_ord[20..25]\n -> ($current_line, $current_column)";
```

Examples:

```
./ch-2.pl "abcdefghijklmnopqrstuvwxyz" \
10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
./ch-2.pl "bbbcccdddaaa"\
4 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
```

Results:

```
string=abcdefghijklmnopqrstuvwxyz
widths=
10 10 10 10 10 10 10 10 10 10
10 10 10 10 10 10 10 10 10 10
10 10 10 10 10 10
-> (3, 60)
string=bbbcccdddaaa
widths=
4 10 10 10 10 10 10 10 10 10
10 10 10 10 10 10 10 10 10 10
10 10 10 10 10 10
-> (2, 4)
```

`_config.yml`

included the line `version: v1.2.0`

. In my laptop
I’m running version 4.3.1, so I replaced that line by ```
version:
v4.3.1
```

, pushed the change and the blog came alive again. I don’t
fully understand what has happened.]]>```
Submitted by: Mohammad Sajid Anwar
You are given two sentences, $line1 and $line2.
Write a script to find all uncommmon words in any order in the given two sentences.
Return ('') if none found.
A word is uncommon if it appears exactly once in one of the sentences and doesn’t
appear in other sentence.
Example 1
Input: $line1 = 'Mango is sweet'
$line2 = 'Mango is sour'
Output: ('sweet', 'sour')
Example 2
Input: $line1 = 'Mango Mango'
$line2 = 'Orange'
Output: ('Orange')
Example 3
Input: $line1 = 'Mango is Mango'
$line2 = 'Orange is Orange'
Output: ('')
```

I split all words of all phrases and count each with a hash. The results are those keys with a count of one. This yields a one-liner.

Example 1:

```
perl -E '
$w{lc $_}++ for split /\W+/, "@ARGV"; say "@ARGV -> ", join " ", (grep {$w{$_}==1} keys %w)
' "Mango is sweet" "mango is sour"
```

Results:

```
Mango is sweet mango is sour -> sour sweet
```

Example 2:

```
perl -E '
$w{lc $_}++ for split /\W+/, "@ARGV"; say "@ARGV -> ", join " ", grep {$w{$_}==1} keys %w
' "Mango mango" "Orange"
```

Results:

```
Mango mango Orange -> orange
```

Example 3:

```
perl -E '
$w{lc $_}++ for split /\W+/, "@ARGV"; say "@ARGV -> ", join " ", grep {$w{$_}==1} keys %w
' "Mango is Mango" "Orange is Orange"
```

Results:

```
Mango is Mango Orange is Orange ->
```

The full code adds some checks and formatting:

```
1 # Perl weekly challenge 266
2 # Task 1: Uncommon Words
3 #
4 # See https://wlmb.github.io/2024/04/21/PWC266/#task-1-uncommon-words
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S1 [S2...]
8 to find uncommon words in the strings S1, S2...
9 FIN
10 my %count;
11 $count{lc $_}++ for split /\W+/, "@ARGV";
12 my @output=sort {$a cmp $b} grep {$count{$_}==1} keys %count;
13 push @output, "''" unless @output;
14 say join " ", map({"'".$_."'"} @ARGV), "->", @output;
```

Examples:

```
./ch-1.pl "Mango is sweet" "Mango is sour"
./ch-1.pl "Mango mango" "orange"
./ch-1.pl "Mango is Mango" "Orange is Orange"
```

Results:

```
'Mango is sweet' 'Mango is sour' -> sour sweet
'Mango mango' 'orange' -> orange
'Mango is Mango' 'Orange is Orange' -> ''
```

```
Submitted by: Mohammad Sajid Anwar
You are given a square matrix, $matrix.
Write a script to find if the given matrix is X Matrix.
A square matrix is an X Matrix if all the elements on the main diagonal
and antidiagonal are non-zero and everything else are zero.
Example 1
Input: $matrix = [ [1, 0, 0, 2],
[0, 3, 4, 0],
[0, 5, 6, 0],
[7, 0, 0, 1],
]
Output: true
Example 2
Input: $matrix = [ [1, 2, 3],
[4, 5, 6],
[7, 8, 9],
]
Output: false
Example 3
Input: $matrix = [ [1, 0, 2],
[0, 3, 0],
[4, 0, 5],
]
Output: true
```

I use the Perl Data Language PDL to manipulate matrices. I build an X shaped matric with 1’s on the diagonals and 0 outside. The result is true if the logical values of all of the entries of the given matrix are equal to those of the X shaped matrix. The result fits a 1.5-liner.

Example 1:

```
perl -MPDL -MPDL::NiceSlice -E '
$m=pdl shift;$x=($m->xvals==$m->yvals)|$m->xvals->(-1:0)==$m->yvals;
say "$m -> ", (!!$m==$x)->all?"True":"False";
' "[[1 0 0 2][0 3 4 0][0 5 6 0][7 0 0 1]]"
```

Results:

```
[
[1 0 0 2]
[0 3 4 0]
[0 5 6 0]
[7 0 0 1]
]
-> True
```

Example 2:

```
perl -MPDL -MPDL::NiceSlice -E '
$m=pdl shift;$x=($m->xvals==$m->yvals)|$m->xvals->(-1:0)==$m->yvals;
say "$m -> ", (!!$m==$x)->all?"True":"False";
' "[[1 2 3][4 5 6][7 8 9]]"
```

Results:

```
[
[1 2 3]
[4 5 6]
[7 8 9]
]
-> False
```

Example 3:

```
perl -MPDL -MPDL::NiceSlice -E '
$m=pdl shift;$x=($m->xvals==$m->yvals)|$m->xvals->(-1:0)==$m->yvals;
say "$m -> ", (!!$m==$x)->all?"True":"False";
' "[[1 0 2][0 3 0][4 0 5]]"
```

Results:

```
[
[1 0 2]
[0 3 0]
[4 0 5]
]
-> True
```

The full code is similar.

```
1 # Perl weekly challenge 266
2 # Task 2: X Matrix
3 #
4 # See https://wlmb.github.io/2024/04/21/PWC266/#task-2-x-matrix
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 M1 [M2...]
10 to find out if the matrices M1, M2... are X shaped.
11 Each matrix should be of the form "[[M11 M12...][M21 M22...]...]"
12 where Mij are the matrix elements. Separating commas are optional.
13 FIN
14 for(@ARGV){
15 my $matrix=pdl $_;
16 my $x=($matrix->xvals==$matrix->yvals) | ($matrix->xvals->(-1:0)==$matrix->yvals);
17 my $output=(!!$matrix == $x)->all?"True":"False";
18 say "$matrix -> $output";
19 }
```

Examples:

```
./ch-2.pl "[[1 0 0 2][0 3 4 0][0 5 6 0][7 0 0 1]]"\
"[[1 2 3][4 5 6][7 8 9]]"\
"[[1 0 2][0 3 0][4 0 5]]"
```

Results:

```
[
[1 0 0 2]
[0 3 4 0]
[0 5 6 0]
[7 0 0 1]
]
-> True
[
[1 2 3]
[4 5 6]
[7 8 9]
]
-> False
[
[1 0 2]
[0 3 0]
[4 0 5]
]
-> True
```

```
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints.
Write a script to find an integer in the given array that appeared 33%
or more. If more than one found, return the smallest. If none found then
return undef.
Example 1
Input: @ints = (1,2,3,3,3,3,4,2)
Output: 3
1 appeared 1 times.
2 appeared 2 times.
3 appeared 4 times.
3 appeared 50% (>33%) in the given array.
Example 2
Input: @ints = (1,1)
Output: 1
1 appeared 2 times.
1 appeared 100% (>33%) in the given array.
Example 3
Input: @ints = (1,2,3)
Output: 1
1 appeared 1 times.
2 appeared 1 times.
3 appeared 1 times.
Since all three appeared 33.3% (>33%) in the given array.
We pick the smallest of all.
```

I use a hash to count
appearances. I `grep`

the integers that appear more than a third of
the times and I use `min`

from `List::Util`

to choose the smallest
one. As division is not exact, I multiply
the number of appearances by three, instead of dividing the number of
integers by three. The result fits a one-liner.

Example 1:

```
perl -MList::Util=min -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", min grep {3*$f{$_}>=@ARGV} keys %f;' 1 2 3 3 3 3 4 2
```

Results:

```
1 2 3 3 3 3 4 2 -> 3
```

Example 2:

```
perl -MList::Util=min -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", min grep {3*$f{$_}>=@ARGV} keys %f;' 1 1
```

Results:

```
1 1 -> 1
```

Example 3:

```
perl -MList::Util=min -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", min grep {3*$f{$_}>=@ARGV} keys %f;' 1 2 3
```

Results:

```
1 2 3 -> 1
```

The full code follows:

```
1 # Perl weekly challenge 265
2 # Task 1: 33% Appearance
3 #
4 # See https://wlmb.github.io/2024/04/16/PWC265/#task-1-33%-appearance
5 use v5.36;
6 use List::Util qw(min);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to find the smallest of the numbers N1... that appears
10 with a frequency of at least a third.
11 FIN
12 my %frequencies;
13 $frequencies{$_}++ for @ARGV;
14 say "@ARGV -> ", (min grep {3*$frequencies{$_}>=@ARGV} keys %frequencies) // "undef";
```

Examples:

```
./ch-1.pl 1 2 3 3 3 3 4 2
./ch-1.pl 1 1
./ch-1.pl 1 2 3
./ch-1.pl 1 2 3 4
```

Results:

```
1 2 3 3 3 3 4 2 -> 3
1 1 -> 1
1 2 3 -> 1
1 2 3 4 -> undef
```

```
Submitted by: Mohammad Sajid Anwar
You are given a string, $str containing alphnumeric characters and
array of strings (alphabetic characters only), @str.
Write a script to find the shortest completing word. If none found
return empty string.
A completing word is a word that contains all the letters in the given
string, ignoring space and number. If a letter appeared more than once
in the given string then it must appear the same number or more in the word.
Example 1
Input: $str = 'aBc 11c'
@str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'
The given string contains following, ignoring case and number:
a 1 times
b 1 times
c 2 times
The only string in the given array that satisfies the condition is 'accbbb'.
Example 2
Input: $str = 'Da2 abc'
@str = ('abcm', 'baacd', 'abaadc')
Output: 'baacd'
The given string contains following, ignoring case and number:
a 2 times
b 1 times
c 1 times
d 1 times
The are 2 strings in the given array that satisfies the condition:
'baacd' and 'abaadc'.
Shortest of the two is 'baacd'
Example 3
Input: $str = 'JB 007'
@str = ('jj', 'bb', 'bjb')
Output: 'bjb'
The given string contains following, ignoring case and number:
j 1 times
b 1 times
The only string in the given array that satisfies the condition is 'bjb'.
```

I make a function that counts letters and ignores non-letters. I `grep`

all words by comparing
their letter counts to those of the initial string and I sort them by
length and, if necessary, alphabetically. The first word is then the
desired result. This yields a 2.5-liner

Example 1:

```
perl -MList::Util=all -E '
($s,@s)=@ARGV; %f=c($s); @v=sort {length $a <=> length $b || $a cmp $b} grep{my %c=c($_);
all {$c{$_} >= $f{$_}} keys %f}@s; say "str=\"$s\" arr=@s -> $v[0]"; sub c($w){my %c; $c{$_}++
for grep {/[a-z]/} split "",lc $w; %c}
' "aBc 11c" accbbb abc abbc
```

Results:

```
str="aBc 11c" arr=accbbb abc abbc -> accbbb
```

Example 2:

```
perl -MList::Util=all -E '
($s,@s)=@ARGV; %f=c($s); @v=sort {length $a <=> length $b || $a cmp $b} grep{my %c=c($_);
all {$c{$_} >= $f{$_}} keys %f}@s; say "str=\"$s\" arr=@s -> $v[0]"; sub c($w){my %c; $c{$_}++
for grep {/[a-z]/} split "",lc $w; %c}
' "Da2 abc" abcm baacd abaadc
```

Results:

```
str="Da2 abc" arr=abcm baacd abaadc -> baacd
```

Example 3:

```
perl -MList::Util=all -E '
($s,@s)=@ARGV; %f=c($s); @v=sort {length $a <=> length $b || $a cmp $b} grep{my %c=c($_);
all {$c{$_} >= $f{$_}} keys %f}@s; say "str=\"$s\" arr=@s -> $v[0]"; sub c($w){my %c; $c{$_}++
for grep {/[a-z]/} split "",lc $w; %c}
' "JB 007" jj bb bjb
```

Results:

```
str="JB 007" arr=jj bb bjb -> bjb
```

Another example:

```
perl -MList::Util=all -E '
($s,@s)=@ARGV; %f=c($s); @v=sort {length $a <=> length $b || $a cmp $b} grep{my %c=c($_);
all {$c{$_} >= $f{$_}} keys %f}@s; say "str=\"$s\" arr=@s -> $v[0]"; sub c($w){my %c; $c{$_}++
for grep {/[a-z]/} split "",lc $w; %c}
' "abc" abc bca cab
```

Results:

```
str="abc" arr=abc bca cab -> abc
```

The full code follows. I added some tests and print “” if there is no completing string.

```
1 # Perl weekly challenge 265
2 # Task 2: Completing Word
3 #
4 # See https://wlmb.github.io/2024/04/16/PWC265/#task-2-completing-word
5 use v5.36;
6 use List::Util qw(all);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S [W1...]
9 to find the shortest completing word of string S among the words W1, W2...
10 FIN
11 my ($string, @words)=@ARGV;
12 my %frequencies = count_letters($string);
13 my @ordered= sort {length $a <=> length $b || $a cmp $b}
14 grep {
15 my %c=count_letters($_);
16 all {
17 ($c{$_}//0) >= $frequencies{$_}
18 }
19 keys %frequencies
20 } @words;
21 say "str=\"$string\" words=@words -> ", $ordered[0] // '""';
22 sub count_letters($word){
23 my %count;
24 $count{$_}++ for grep {/[a-z]/} split "",lc $word;
25 %count
26 }
```

Examples:

```
./ch-2.pl "aBc 11c" accbbb abc abbc
./ch-2.pl "Da2 abc" abcm baacd abaadc
./ch-2.pl "JB 007" jj bb bjb
./ch-2.pl "abc" abc bca cab
./ch-2.pl "abc" ab bc ca
```

Results:

```
str="aBc 11c" words=accbbb abc abbc -> accbbb
str="Da2 abc" words=abcm baacd abaadc -> baacd
str="JB 007" words=jj bb bjb -> bjb
str="abc" words=abc bca cab -> abc
str="abc" words=ab bc ca -> ""
```

```
Submitted by: Mohammad Sajid Anwar
You are given a string, $str, made up of only alphabetic characters [a..zA..Z].
Write a script to return the greatest english letter in the given string.
A letter is greatest if it occurs as lower and upper case. Also letter ‘b’ is greater
than ‘a’ if ‘b’ appears after ‘a’ in the English alphabet.
Example 1
Input: $str = 'PeRlwEeKLy'
Output: L
There are two letters E and L that appears as lower and upper.
The letter L appears after E, so the L is the greatest english letter.
Example 2
Input: $str = 'ChaLlenge'
Output: L
Example 3
Input: $str = 'The'
Output: ''
```

First I count the times each letter appears. Then I `grep`

those
letters that appear in both upper and lower case and I choose the
maximum with `maxstr`

from `List::Utils`

. The code fits a one-liner.

Example 1:

```
perl -MList::Util=maxstr -E '
$s{$_}++ for split "", $i=shift; say "$i -> ", maxstr grep {$_ eq uc && $s{lc $_}}keys %s;
' PeRlwEeKLy
```

Results:

```
PeRlwEeKLy -> L
```

Example 2:

```
perl -MList::Util=maxstr -E '
$s{$_}++ for split "", $i=shift; say "$i -> ", maxstr grep {$_ eq uc && $s{lc $_}}keys %s;
' ChaLlenge
```

Results:

```
ChaLlenge -> L
```

Example 3:

```
perl -MList::Util=maxstr -E '
$s{$_}++ for split "", $i=shift; say "$i -> ", maxstr grep {$_ eq uc && $s{lc $_}}keys %s;
' The
```

Results:

```
The ->
```

The full code only adds a few checks.

```
1 # Perl weekly challenge 264
2 # Task 1: Greatest English Letter
3 #
4 # See https://wlmb.github.io/2024/04/12/PWC264/#task-1-greatest-english-letter
5 use v5.36;
6 use List::Util qw(maxstr);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S1 [S2...]
9 to find the greatest English letter of each string S1, S2...
10 FIN
11 for(@ARGV){
12 warn("Only alphabetical characters allowed a..z A..Z"), next unless /^[a-zA-Z]+$/;
13 my %seen;
14 $seen{$_}++ for split "";
15 say "$_ -> ", maxstr grep {$_ eq uc && $seen{lc $_}}keys %seen;
16 }
17
```

Examples:

```
./ch-1.pl PeRlwEeKLy ChaLlenge The
```

Results:

```
PeRlwEeKLy -> L
ChaLlenge -> L
The ->
```

```
Submitted by: Mohammad Sajid Anwar
You are given two arrays of integers, @source and @indices. The @indices can only
contains integers 0 <= i < size of @source.
Write a script to create target array by insert at index $indices[i] the value
$source[i].
Example 1
Input: @source = (0, 1, 2, 3, 4)
@indices = (0, 1, 2, 2, 1)
Output: (0, 4, 1, 3, 2)
@source @indices @target
0 0 (0)
1 1 (0, 1)
2 2 (0, 1, 2)
3 2 (0, 1, 3, 2)
4 1 (0, 4, 1, 3, 2)
Example 2
Input: @source = (1, 2, 3, 4, 0)
@indices = (0, 1, 2, 3, 0)
Output: (0, 1, 2, 3, 4)
@source @indices @target
1 0 (1)
2 1 (1, 2)
3 2 (1, 2, 3)
4 3 (1, 2, 3, 4)
0 0 (0, 1, 2, 3, 4)
Example 3
Input: @source = (1)
@indices = (0)
Output: (1)
```

This may be solved by `splicing`

the values into place. I assume the
inputs are the source and the indices as space separated arrays. The
result fits a oneliner.

Example 1:

```
perl -E '
@s=split " ", shift; @i=split " ", shift; splice @o, $i[$_],0,$s[$_] for 0..@i-1; say "s=(@s), i=(@i) -> (@o)";
' "0 1 2 3 4" "0 1 2 2 1"
```

Results:

```
s=(0 1 2 3 4), i=(0 1 2 2 1) -> (0 4 1 3 2)
```

Example 2:

```
perl -E '
@s=split " ", shift; @i=split " ", shift; splice @o, $i[$_],0,$s[$_] for 0..@i-1; say "s=(@s), i=(@i) -> (@o)";
' "1 2 3 4 0" "0 1 2 3 0"
```

Results:

```
s=(1 2 3 4 0), i=(0 1 2 3 0) -> (0 1 2 3 4)
```

Example 3:

```
perl -E '
@s=split " ", shift; @i=split " ", shift; splice @o, $i[$_],0,$s[$_] for 0..@i-1; say "s=(@s), i=(@i) -> (@o)";
' "1" "0"
```

Results:

```
s=(1), i=(0) -> (1)
```

The full code just adds some checks.

```
1 # Perl weekly challenge 264
2 # Task 2: Target Array
3 #
4 # See https://wlmb.github.io/2024/04/12/PWC264/#task-2-target-array
5 use v5.36;
6 use experimental qw(for_list);
7 LOOP: for my ($source, $indices)(@ARGV){
8 my @source=split " ", $source;
9 my @indices=split " ", $indices;
10 my @output;
11 for(0..@indices-1){
12 warn("Index out of range"), next LOOP unless 0 <= $_ < @source;
13 splice @output, $indices[$_],0,$source[$_];
14 }
15 say "source=(@source), indices=(@indices) -> (@output)";
16 }
```

Examples:

```
./ch-2.pl "0 1 2 3 4" "0 1 2 2 1" "1 2 3 4 0" "0 1 2 3 0" "1" "0"
```

Results:

```
source=(0 1 2 3 4), indices=(0 1 2 2 1) -> (0 4 1 3 2)
source=(1 2 3 4 0), indices=(0 1 2 3 0) -> (0 1 2 3 4)
source=(1), indices=(0) -> (1)
```

/;

]]>```
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints and a target element $k.
Write a script to return the list of indices in the sorted array where
the element is same as the given target element.
Example 1
Input: @ints = (1, 5, 3, 2, 4, 2), $k = 2
Output: (1, 2)
Sorted array: (1, 2, 2, 3, 4, 5)
Target indices: (1, 2) as $ints[1] = 2 and $k[2] = 2
Example 2
Input: @ints = (1, 2, 4, 3, 5), $k = 6
Output: ()
No element in the given array matching the given target.
Example 3
Input: @ints = (5, 3, 2, 4, 2, 1), $k = 4
Output: (4)
Sorted array: (1, 2, 2, 3, 4, 5)
Target index: (4) as $ints[4] = 4
```

The task seems straightforward: sort the entries and filter the indices. I assume the arguments are in @ARGV starting with k.

Example 1:

```
perl -E '
$k=shift; @x=sort{$a<=>$b}@ARGV; say "k=$k, ints=(@ARGV) -> ", join " ", "(", grep({$x[$_]==$k} (0..@x-1)), ")";
' 2 1 5 3 2 4 2
```

Results:

```
k=2, ints=(1 5 3 2 4 2) -> ( 1 2 )
```

Example 2:

```
perl -E '
$k=shift; @x=sort{$a<=>$b}@ARGV; say "k=$k, ints=(@ARGV) -> ", join " ", "(", grep({$x[$_]==$k} (0..@x-1)), ")";
' 6 1 2 4 3 5
```

Results:

```
k=6, ints=(1 2 4 3 5) -> ( )
```

Example 3:

```
perl -E '
$k=shift; @x=sort{$a<=>$b}@ARGV; say "k=$k, ints=(@ARGV) -> ", join " ", "(", grep({$x[$_]==$k} (0..@x-1)), ")";
' 4 5 3 2 4 2 1
```

Results:

```
k=4, ints=(5 3 2 4 2 1) -> ( 4 )
```

The full code follows:

```
1 # Perl weekly challenge 263
2 # Task 1: Target Index
3 #
4 # See https://wlmb.github.io/2024/04/01/PWC263/#task-1-target-index
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 k N0 [N1...]
8 to find the indices of the array N0 N1... (after sorting) for which
9 N_i=k
10 FIN
11 my $k=shift;
12 my @sorted=sort{$a<=>$b}@ARGV;
13 say "k=$k, ints=(@ARGV) -> ",
14 join " ", "(", grep({$sorted[$_]==$k} (0..@sorted-1)), ")";
```

Example:

```
for i in "2 1 5 3 2 4 2" "6 1 2 4 3 5" "4 5 3 2 4 2 1";do ./ch-1.pl `echo $i`; done
```

Results:

```
k=2, ints=(1 5 3 2 4 2) -> ( 1 2 )
k=6, ints=(1 2 4 3 5) -> ( )
k=4, ints=(5 3 2 4 2 1) -> ( 4 )
```

```
Submitted by: Mohammad Sajid Anwar
You are given two 2-D array of positive integers, $items1 and $items2
where element is pair of (item_id, item_quantity).
Write a script to return the merged items.
Example 1
Input: $items1 = [ [1,1], [2,1], [3,2] ]
$items2 = [ [2,2], [1,3] ]
Output: [ [1,4], [2,3], [3,2] ]
Item id (1) appears 2 times: [1,1] and [1,3]. Merged item now (1,4)
Item id (2) appears 2 times: [2,1] and [2,2]. Merged item now (2,3)
Item id (3) appears 1 time: [3,2]
Example 2
Input: $items1 = [ [1,2], [2,3], [1,3], [3,2] ]
$items2 = [ [3,1], [1,3] ]
Output: [ [1,8], [2,3], [3,3] ]
Example 3
Input: $items1 = [ [1,1], [2,2], [3,3] ]
$items2 = [ [2,3], [2,4] ]
Output: [ [1,1], [2,9], [3,3] ]
```

As items to be merged may be part of the same list, it seems
unnecesary to keep them in two lists. I use PDL to easily convert
between several nested arrays to a simple list which I iterate using
the new `for_list`

. I accumulate values in a hash and finally, I print
key,value pairs. This fits a longish one-liner.

Example 1:

```
perl -Mexperimental=for_list -MPDL -E '
push @e, pdl($_)->list for @ARGV;for my($x,$y)(@e){$v{$x}+=$y};@r=map {"[$_,$v{$_}]"} keys %v;say "@ARGV -> [@r]";
' "[[1,2],[2,3],[1,3],[3,2]]" "[[3,1],[1,3]]"
```

Results:

```
[[1,2],[2,3],[1,3],[3,2]] [[3,1],[1,3]] -> [[1,8] [3,3] [2,3]]
```

I got the expected results but unsorted.

Example 2:

```
perl -Mexperimental=for_list -MPDL -E '
push @e, pdl($_)->list for @ARGV;for my($x,$y)(@e){$v{$x}+=$y};@r=map {"[$_,$v{$_}]"} keys %v;say "@ARGV -> [@r]";
' "[[1,2],[2,3],[1,3],[3,2]]" "[[3,1],[1,3]]"
```

Results:

```
[[1,2],[2,3],[1,3],[3,2]] [[3,1],[1,3]] -> [[2,3] [3,3] [1,8]]
```

Example 3:

```
perl -Mexperimental=for_list -MPDL -E '
push @e, pdl($_)->list for @ARGV;for my($x,$y)(@e){$v{$x}+=$y};@r=map {"[$_,$v{$_}]"} keys %v;say "@ARGV -> [@r]";
' "[[1,1],[2,2],[3,3]]" "[[2,3],[2,4]]"
```

Results:

```
[[1,1],[2,2],[3,3]] [[2,3],[2,4]] -> [[1,1] [2,9] [3,3]]
```

The full code is similar. I just add some checks and I sort the result.

```
1 # Perl weekly challenge 263
2 # Task 2: Merge Items
3 #
4 # See https://wlmb.github.io/2024/04/01/PWC263/#task-2-merge-items
5 use v5.36;
6 use PDL; # use the perl data language to convert the input to a list of keys-values
7 use experimental qw(for_list); # use for list to process key-value pairs
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 "[[K11,V11],[K12,V12]...]]" "[[K21,V21],[K22,V22],...]" ...
10 to accumulate all values Vij corresponding to each unique key Kn=Kij
11 FIN
12 my @keyvals;
13 push @keyvals, pdl($_)->list for @ARGV;
14 my %merged;
15 for my($key, $val)(@keyvals){
16 $merged{$key}+=$val
17 };
18 my @result = map {"[$_,$merged{$_}]"} sort {$a cmp $b} keys %merged;
19 say "@ARGV -> [@result]";
```

Example:

```
./ch-2.pl "[[1,2],[2,3],[1,3],[3,2]]" "[[3,1],[1,3]]"
./ch-2.pl "[[1,2],[2,3],[1,3],[3,2]]" "[[3,1],[1,3]]"
./ch-2.pl "[[1,1],[2,2],[3,3]]" "[[2,3],[2,4]]"
```

Results:

```
[[1,2],[2,3],[1,3],[3,2]] [[3,1],[1,3]] -> [[1,8] [2,3] [3,3]]
[[1,2],[2,3],[1,3],[3,2]] [[3,1],[1,3]] -> [[1,8] [2,3] [3,3]]
[[1,1],[2,2],[3,3]] [[2,3],[2,4]] -> [[1,1] [2,9] [3,3]]
```

Note that I may more or less than two input arrays.

Other examples:

```
./ch-2.pl "[[1,2],[2,3],[1,3],[3,2]]"
./ch-2.pl "[[1,2],[2,3],[1,3],[3,2]]" "[[3,1],[1,3]]" "[[1,1],[2,2],[3,3]]" "[[2,3],[2,4]]"
```

Results:

```
[[1,2],[2,3],[1,3],[3,2]] -> [[1,5] [2,3] [3,2]]
[[1,2],[2,3],[1,3],[3,2]] [[3,1],[1,3]] [[1,1],[2,2],[3,3]] [[2,3],[2,4]] -> [[1,9] [2,12] [3,6]]
```

Map

Descent into first ravine

Continue descending

Early morning shadow of cyclist

Bottom of ravine. River is dry at this time of year.

View towards the west from the Tetepetla slope. If you zoom you may see moon a week before eclipsing the sun

Someone forgot the containers after a reforesting campaign.

Temporary bicycle repair workshop; had to change brake pads.

Young, recently planted trees.

View towards the north. The Zempoala summit is visible

View towards the north. The Zempoala summit is visible

Tetepetla sign

Path up the slope

Though everything is dry, there are a few flowers.

Flowers from the other side

Wildfire watch tower, on the opposite side of the ravine.

The road is covered in dry leaves.

Structure to avoid or slow down erosion.

Start of downhill slope, 2550m above sea level.

Downhill path.

Path close to the stream.

Stream, also dry.

Path up from the stream

]]>