```
Submitted by: Mohammad Sajid Anwar
You are given a array of integers, @ints.
Write a script to find out how many integers are smaller than current
i.e. foreach ints[i], count ints[j] < ints[i] where i != j.
Example 1
Input: @ints = (5, 2, 1, 6)
Output: (2, 1, 0, 3)
For $ints[0] = 5, there are two integers (2,1) smaller than 5.
For $ints[1] = 2, there is one integer (1) smaller than 2.
For $ints[2] = 1, there is none integer smaller than 1.
For $ints[3] = 6, there are three integers (5,2,1) smaller than 6.
Example 2
Input: @ints = (1, 2, 0, 3)
Output: (1, 2, 0, 3)
Example 3
Input: @ints = (0, 1)
Output: (0, 1)
Example 4
Input: @ints = (9, 4, 9, 2)
Output: (2, 1, 2, 0)
```

To solve this problem I sort the `uniq`

numbers in the array, so that
the number of smaller elements is their corresponding index. Then, I
build a hash to store those numbers, and with that hash and the
original numbers I build the result. This fits a oneliner.

Example 1:

```
perl -MList::Util=uniq -E '
@s=sort {$a<=>$b} uniq @x=@ARGV;$c{$s[$_]}=$_ for 0..@s-1; say "@x -> @c{@x}"
' 5 2 1 6
```

Results:

```
5 2 1 6 -> 2 1 0 3
```

Example 2:

```
perl -MList::Util=uniq -E '
@s=sort {$a<=>$b} uniq @x=@ARGV;$c{$s[$_]}=$_ for 0..@s-1; say "@x -> @c{@x}"
' 1 2 0 3
```

Results:

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

Example 3:

```
perl -MList::Util=uniq -E '
@s=sort {$a<=>$b} uniq @x=@ARGV;$c{$s[$_]}=$_ for 0..@s-1; say "@x -> @c{@x}"
' 0 1
```

Results:

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

Example 4:

```
perl -MList::Util=uniq -E '
@s=sort {$a<=>$b} uniq @x=@ARGV;$c{$s[$_]}=$_ for 0..@s-1; say "@x -> @c{@x}"
' 9 4 9 2
```

Results:

```
9 4 9 2 -> 2 1 2 0
```

The full code follows:

```
1 # Perl weekly challenge 257
2 # Task 1: Smaller than Current
3 #
4 # See https://wlmb.github.io/2024/02/20/PWC257/#task-1-smaller-than-current
5 use v5.36;
6 use List::Util qw(uniq);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to count how many numbers Nj are smaller than Ni
10 FIN
11 my @sorted=sort {$a<=>$b} uniq @ARGV;
12 my %count;
13 $count{$sorted[$_]}=$_ for 0..@sorted-1;
14 say "@ARGV -> @count{@ARGV}";
```

Examples:

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

Results:

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

```
Submitted by: Ali Moradi
Given a matrix M, check whether the matrix is in reduced row echelon form.
A matrix must have the following properties to be in reduced row echelon form:
1. If a row does not consist entirely of zeros, then the first
nonzero number in the row is a 1. We call this the leading 1.
2. If there are any rows that consist entirely of zeros, then
they are grouped together at the bottom of the matrix.
3. In any two successive rows that do not consist entirely of zeros,
the leading 1 in the lower row occurs farther to the right than
the leading 1 in the higher row.
4. Each column that contains a leading 1 has zeros everywhere else
in that column.
For example:
[
[1,0,0,1],
[0,1,0,2],
[0,0,1,3]
]
The above matrix is in reduced row echelon form since the first nonzero
number in each row is a 1, leading 1s in each successive row are farther
to the right, and above and below each leading 1 there are only zeros.
For more information check out this wikipedia article.
Example 1
Input: $M = [
[1, 1, 0],
[0, 1, 0],
[0, 0, 0]
]
Output: 0
Example 2
Input: $M = [
[0, 1,-2, 0, 1],
[0, 0, 0, 1, 3],
[0, 0, 0, 0, 0],
[0, 0, 0, 0, 0]
]
Output: 1
Example 3
Input: $M = [
[1, 0, 0, 4],
[0, 1, 0, 7],
[0, 0, 1,-1]
]
Output: 1
Example 4
Input: $M = [
[0, 1,-2, 0, 1],
[0, 0, 0, 0, 0],
[0, 0, 0, 1, 3],
[0, 0, 0, 0, 0]
]
Output: 0
Example 5
Input: $M = [
[0, 1, 0],
[1, 0, 0],
[0, 0, 0]
]
Output: 0
Example 6
Input: $M = [
[4, 0, 0, 0],
[0, 1, 0, 7],
[0, 0, 1,-1]
]
Output: 0
```

To solve this problem I apply the definition. First I make an array of the indices of the first non-zero coefficient and check that it is increasing. Then I check that all zero rows, if any, are at the end. Then I check that the first non-null coefficient for each row is 1 and finally I check that all elements above it are zero (no need to check those below). The rows are input as space separated strings of numbers. The code fits a not too nice 3.5-liner. The full code explains it better.

Example 1:

```
perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {$_} @$_} @m;$l=firstidx {$_==-1}@i;$l=@i if $l==-1;
$r=all{$i[$_]==-1}$l+1..@i-1;$r&&=all{$i[$_]<$i[$_+1]} 0..$l-2;$r&&=all{$m[$_][$i[$_]]==1} 0..$l-1;
$j=$i[$_],$r&&=none{$m[$_][$j]} (0..$_-1) for 0..$l-1;say join "\n", "[", map({join " ",
" [", @$_, "]"}@m), "]", "-> ", $r||0;
' "1 1 0" "0 1 0" "0 0 0"
```

Results:

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

Example 2:

```
perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {$_} @$_} @m;$l=firstidx {$_==-1}@i;$l=@i if $l==-1;
$r=all{$i[$_]==-1}$l+1..@i-1;$r&&=all{$i[$_]<$i[$_+1]} 0..$l-2;$r&&=all{$m[$_][$i[$_]]==1} 0..$l-1;
$j=$i[$_],$r&&=none{$m[$_][$j]} (0..$_-1) for 0..$l-1;say join "\n", "[", map({join " ",
" [", @$_, "]"}@m), "]", "-> ", $r||0;
' "0 1 -2 0 1" "0 0 0 1 3" "0 0 0 0 0" "0 0 0 0 0"
```

Results:

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

Example 3:

```
perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {$_} @$_} @m;$l=firstidx {$_==-1}@i;$l=@i if $l==-1;
$r=all{$i[$_]==-1}$l+1..@i-1;$r&&=all{$i[$_]<$i[$_+1]} 0..$l-2;$r&&=all{$m[$_][$i[$_]]==1} 0..$l-1;
$j=$i[$_],$r&&=none{$m[$_][$j]} (0..$_-1) for 0..$l-1;say join "\n", "[", map({join " ",
" [", @$_, "]"}@m), "]", "-> ", $r||0;
' "1 0 0 4" "0 1 0 7" "0 0 1 -1"
```

Results:

```
[
[ 1 0 0 4 ]
[ 0 1 0 7 ]
[ 0 0 1 -1 ]
]
->
1
```

Example 4:

```
perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {$_} @$_} @m;$l=firstidx {$_==-1}@i;$l=@i if $l==-1;
$r=all{$i[$_]==-1}$l+1..@i-1;$r&&=all{$i[$_]<$i[$_+1]} 0..$l-2;$r&&=all{$m[$_][$i[$_]]==1} 0..$l-1;
$j=$i[$_],$r&&=none{$m[$_][$j]} (0..$_-1) for 0..$l-1;say join "\n", "[", map({join " ",
" [", @$_, "]"}@m), "]", "-> ", $r||0;
' "0 1 -2 0 1" "0 0 0 0 0" "0 0 0 1 3" "0 0 0 0 0"
```

Results:

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

Example 5:

```
perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {$_} @$_} @m;$l=firstidx {$_==-1}@i;$l=@i if $l==-1;
$r=all{$i[$_]==-1}$l+1..@i-1;$r&&=all{$i[$_]<$i[$_+1]} 0..$l-2;$r&&=all{$m[$_][$i[$_]]==1} 0..$l-1;
$j=$i[$_],$r&&=none{$m[$_][$j]} (0..$_-1) for 0..$l-1;say join "\n", "[", map({join " ",
" [", @$_, "]"}@m), "]", "-> ", $r||0;
' "0 1 -2 0 1" "0 0 0 0 0" "0 0 0 1 3" "0 0 0 0 0"
' "0 1 0" "1 0 0" "0 0 0"
```

Results:

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

Example 6:

```
perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {$_} @$_} @m;$l=firstidx {$_==-1}@i;$l=@i if $l==-1;
$r=all{$i[$_]==-1}$l+1..@i-1;$r&&=all{$i[$_]<$i[$_+1]} 0..$l-2;$r&&=all{$m[$_][$i[$_]]==1} 0..$l-1;
$j=$i[$_],$r&&=none{$m[$_][$j]} (0..$_-1) for 0..$l-1;say join "\n", "[", map({join " ",
" [", @$_, "]"}@m), "]", "-> ", $r||0;
' "4 0 0 0" "0 1 0 7" "0 0 1 -1"
```

Results:

```
[
[ 4 0 0 0 ]
[ 0 1 0 7 ]
[ 0 0 1 -1 ]
]
->
0
```

The full code follows:

```
1 # Perl weekly challenge 257
2 # Task 2: Reduced Row Echelon
3 #
4 # See https://wlmb.github.io/2024/02/20/PWC257/#task-2-reduced-row-echelon
5 use v5.36;
6 use List::AllUtils qw(firstidx reduce all none);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 R0 [R1...]
9 where Rn is a space separated row of the form
10 "Mn0 Mn1... Mnm"
11 and Mij are numbers, the entries of a matrix M,
12 to test if M is a reduced row echelon matrix
13 FIN
14 # Read matrix
15 my @matrix;
16 push @matrix, map {[split " "]} @ARGV;
17 my @indices_first=map {firstidx {$_} @$_} @matrix; #indices of first non null element of each row
18 my $first_empty=firstidx {$_==-1}@indices_first; # first row of zeroes
19 $first_empty=@indices_first if $first_empty==-1; # none found
20 my $result=all{$indices_first[$_]==-1}$first_empty+1..@indices_first-1; # all zero rows at end
21 $result &&= all{$indices_first[$_] < $indices_first[$_+1]} 0..$first_empty-2; # to right of previous
22 $result&&=all{$matrix[$_][$indices_first[$_]]==1} 0..$first_empty-1; #leading non zero are ones
23 for(0..$first_empty-1){
24 my $j=$indices_first[$_];
25 $result &&= none{$matrix[$_][$j]} (0..$_-1); # check zeroes above first non-zero
26 }
27 say join "\n", "[", map({join " ", " [", @$_, "]"}@matrix), "]", "-> ", $result||0, "\n";
```

Examples:

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

Results:

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

An alternative solution may be obtained with the *Perl Data Language* PDL. I read the
matrices from @ARGV, convert them to ndarrays, add guard columns at
the beginning (zeroes) and at the end (a unit matrix) to simplify the
tests, and run-length-encode the matrix to find for each row its repeated
elements and their frequency. The frequencies are the positions of the
first nonzero element. Thus, check that the frequencies are never
decreasing (they should be strictly increasing, but a later check
makes this unnecessary). Then check that the second value (the first
non-zero) is a one for all rows. Finally check that in the column
above the first non-zero elements there are just zeroes. This yields a 2.5liner.

```
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$m0=pdl(0)->glue(0,$m=pdl($_),identity($m->dim(1)));($f,$v)=$m0->rle;$f=$f((0));
$r=all($f==$f->qsort);$r&&=all($v((1))==1);for(1..$m->dim(1)-1){$j=$f(($_));
$r&&=all($m0->(($j),0:$_-1)==0)}say "$m -> $r"}
' "[[1 1 0][0 1 0][0 0 0]]" "[[0 1 -2 0 1][0 0 0 1 3][0 0 0 0 0][0 0 0 0 0]]" \
"[[1 0 0 4][0 1 0 7][0 0 1 -1]]" "[[0 1 -2 0 1][0 0 0 0 0][0 0 0 1 3][0 0 0 0 0]]" \
"[[0 1 0][1 0 0][0 0 0]]" "[[4 0 0 0][0 1 0 7][0 0 1 -1]]"
```

Results:

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

The corresponding full code is

```
1 # Perl weekly challenge 257
2 # Task 2: Reduced Row Echelon. PDL solution
3 #
4 # See https://wlmb.github.io/2024/02/20/PWC257/#task-2-reduced-row-echelon
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 M1 [M2...]
10 to check if the matrices Mn is a reduced row echelon matrix.
11 The matrices are strings of the form
12 "[[M11 M12..][M21 M22...]...]" where each Mij is a number,
13 the element in the i-th row and j-th column.
14 FIN
15 for(@ARGV){
16 my $matrix=pdl($_);
17 my $extended_matrix=pdl(0)->glue(0, $matrix, identity($matrix->dim(1)));
18 my ($freq,$vals)=$extended_matrix->rle; # run length encode
19 $freq=$freq((0)); # number of leading zeroes
20 my $result=all($freq==$freq->qsort); # check non-decreasing
21 $result &&= all($vals((1))==1); # leading non-zero is 1
22 for(1..$matrix->dim(1)-1){
23 my $j=$freq(($_)); # position of first non zero of $_ row
24 $result &&= all($extended_matrix(($j),0:$_-1)==0)
25 }
26 say "$matrix -> $result"
27 }
```

Examples:

```
./ch-2a.pl "[[1 1 0][0 1 0][0 0 0]]" "[[0 1 -2 0 1][0 0 0 1 3][0 0 0 0 0][0 0 0 0 0]]" \
"[[1 0 0 4][0 1 0 7][0 0 1 -1]]" "[[0 1 -2 0 1][0 0 0 0 0][0 0 0 1 3][0 0 0 0 0]]" \
"[[0 1 0][1 0 0][0 0 0]]" "[[4 0 0 0][0 1 0 7][0 0 1 -1]]"
```

Results:

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

/;

]]>```
Submitted by: Mohammad Sajid Anwar
You are given an array of distinct words, @words.
Write a script to find the maximum pairs in the given array.
The words $words[i] and $words[j] can be a pair one is reverse of the other.
Example 1
Input: @words = ("ab", "de", "ed", "bc")
Output: 1
There is one pair in the given array: "de" and "ed"
Example 2
Input: @words = ("aa", "ba", "cd", "ed")
Output: 0
Example 3
Input: @words = ("uv", "qp", "st", "vu", "mn", "pq")
Output: 2
```

A solution could be obtained by keeping a hash for counting each word and its reverse, incrementing it for each word found and decrementing it for each reverse found. Then, the number of pairs is one half the number of resulting zeroes, assumming each word can be paired with at most one other word. I have to take precautions for not pairing a symmetric word with itself. This yields a one-liner.

Example 1:

```
perl -MList::Util=sum0 -E '
++$c{$_}, $_ ne ($x= reverse $_)&& --$c{$x} for @ARGV; say "@ARGV -> ", (sum0 map {!$_} values %c)/2
' ab de ed bc
```

Results:

```
ab de ed bc -> 1
```

Example 2:

```
perl -MList::Util=sum0 -E '
++$c{$_}, $_ ne ($x= reverse $_)&& --$c{$x} for @ARGV; say "@ARGV -> ", (sum0 map {!$_} values %c)/2
' aa ba cd ef
```

Results:

```
aa ba cd ef -> 0
```

Example 3:

```
perl -MList::Util=sum0 -E '
++$c{$_}, $_ ne ($x= reverse $_)&& --$c{$x} for @ARGV; say "@ARGV -> ", (sum0 map {!$_} values %c)/2
' uv qp st vu mn pq
```

Results:

```
uv qp st vu mn pq -> 2
```

The problem with this code is that each word may be a part of more than one pair. Thus an alternative is to multiply the number of times a word appears by the number of times its reverse appears, add these numbers and divide by to to eliminate duplicates. I have to take care in the case where a word is equal to its reverse, as I shouldn’t pair a word with itself.

Examples:

```
perl -MList::Util=sum0 -E '
++$c{$_} for @ARGV; say "@ARGV -> ", (sum0 map {$c{$_}*($c{$x=reverse($_)}-($x eq $_))} keys %c)/2
' ab de ed bc
perl -MList::Util=sum0 -E '
++$c{$_} for @ARGV; say "@ARGV -> ", (sum0 map {$c{$_}*($c{$x=reverse($_)}-($x eq $_))} keys %c)/2
' aa ba cd ef
perl -MList::Util=sum0 -E '
++$c{$_} for @ARGV; say "@ARGV -> ", (sum0 map {$c{$_}*($c{$x=reverse($_)}-($x eq $_))} keys %c)/2
' uv qp st vu mn pq
```

Results:

```
ab de ed bc -> 1
aa ba cd ef -> 0
uv qp st vu mn pq -> 2
```

Examples with multiple pairs:

```
perl -MList::Util=sum0 -E '
++$c{$_} for @ARGV; say "@ARGV -> ", (sum0 map {$c{$_}*($c{$x=reverse($_)}-($x eq $_))} keys %c)/2
' de ed ed
perl -MList::Util=sum0 -E '
++$c{$_} for @ARGV; say "@ARGV -> ", (sum0 map {$c{$_}*($c{$x=reverse($_)}-($x eq $_))} keys %c)/2
' aa aa aa
perl -MList::Util=sum0 -E '
++$c{$_} for @ARGV; say "@ARGV -> ", (sum0 map {$c{$_}*($c{$x=reverse($_)}-($x eq $_))} keys %c)/2
' uv uv vu vu
```

Results:

```
de ed ed -> 2
aa aa aa -> 3
uv uv vu vu -> 4
```

The full code based in the first approach follows:

```
1 # Perl weekly challenge 256
2 # Task 1: Maximum Pairs
3 #
4 # See https://wlmb.github.io/2024/02/12/PWC256/#task-1-maximum-pairs
5 use v5.36;
6 use List::Util qw(sum0);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S1 [S2...]
9 to pair Si with the reverse Sj and count the resulting pairs
10 assuming at most one pair per string.
11 FIN
12 my %count;
13 my $reverse;
14 for (@ARGV){
15 ++$count{$_};
16 my $reverse=reverse $_;
17 --$count{$reverse} unless $reverse eq $_;
18 }
19 say "@ARGV -> ", (sum0 map {!$_} values %count)/2;
```

Examples:

```
./ch-1.pl ab de ed bc
./ch-1.pl aa ba cd ef
./ch-1.pl uv qp st vu mn pq
```

Results:

```
ab de ed bc -> 1
aa ba cd ef -> 0
uv qp st vu mn pq -> 2
```

The full code based in the second approach is:

```
1 # Perl weekly challenge 256
2 # Task 1: Maximum Pairs
3 #
4 # See https://wlmb.github.io/2024/02/12/PWC256/#task-1-maximum-pairs
5 use v5.36;
6 use List::Util qw(sum0);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S1 [S2...]
9 to pair Si with the reverse Sj and count the resulting pairs
10 FIN
11 my %count;
12 ++$count{$_} for (@ARGV);
13 my $result = (sum0 map {
14 my $reverse=reverse $_;
15 my $selfreverse=$_ eq $reverse;
16 $count{$_}*(($count{$reverse}//0)-$selfreverse)
17 } keys %count)/2;
18 say "@ARGV -> $result";
```

Examples:

```
./ch-1a.pl ab de ed bc
./ch-1a.pl aa ba cd ef
./ch-1a.pl uv qp st vu mn pq
./ch-1a.pl de ed ed
./ch-1a.pl aa aa aa
./ch-1a.pl uv uv vu vu
```

Results:

```
ab de ed bc -> 1
aa ba cd ef -> 0
uv qp st vu mn pq -> 2
de ed ed -> 2
aa aa aa -> 3
uv uv vu vu -> 4
```

```
Submitted by: Mohammad Sajid Anwar
You are given two strings, $str1 and $str2.
Write a script to merge the given strings by adding in alternative
order starting with the first string. If a string is longer than the
other then append the remaining at the end.
Example 1
Input: $str1 = "abcd", $str2 = "1234"
Output: "a1b2c3d4"
Example 2
Input: $str1 = "abc", $str2 = "12345"
Output: "a1b2c345"
Example 3
Input: $str1 = "abcde", $str2 = "123"
Output: "a1b2c3de"
```

I split the inputs into two arrays and I call a routine alternatively on both to shift their elements and return them, or return empty strings if the given array is empty. I proceed until both arrays are empty and I concatenate the returned strings. This fits a one-liner.

Example 1:

```
perl -E '
sub f($x){shift @$x||""}($x,$y)=map{[split ""]}@ARGV;$o.=f($x).f$y while(@$x||@$y);say "@ARGV -> $o"
' abcd 1234
```

Results:

```
abcd 1234 -> a1b2c3d4
```

Example 2:

```
perl -E '
sub f($x){shift @$x||""}($x,$y)=map{[split ""]}@ARGV;$o.=f($x).f$y while(@$x||@$y);say "@ARGV -> $o"
' abc 12345
```

Results:

```
abc 12345 -> a1b2c345
```

Example 3:

```
perl -E '
sub f($x){shift @$x||""}($x,$y)=map{[split ""]}@ARGV;$o.=f($x).f$y while(@$x||@$y);say "@ARGV -> $o"
' abcde 123
```

Results:

```
abcde 123 -> a1b2c3de
```

The full code is:

```
1 # Perl weekly challenge 256
2 # Task 2: Merge Strings
3 #
4 # See https://wlmb.github.io/2024/02/12/PWC256/#task-2-merge-strings
5 use v5.36;
6 sub next_char($x){
7 shift @$x||""
8 }
9 my ($x,$y)=map{[split ""]}@ARGV;
10 my $out="";
11 $out.=next_char($x) . next_char($y) while(@$x||@$y);
12 say "@ARGV -> $out"
```

Example:

```
./ch-2.pl abcd 1234
./ch-2.pl abc 12345
./ch-2.pl abcde 123
```

Results:

```
abcd 1234 -> a1b2c3d4
abc 12345 -> a1b2c345
abcde 123 -> a1b2c3de
```

```
Submitted by: Mohammad Sajid Anwar
You are given two strings, $s and $t. The string $t is generated
using the shuffled characters of the string $s with an additional character.
Write a script to find the additional character in the string $t..
Example 1
Input: $s = "Perl" $t = "Preel"
Output: "e"
Example 2
Input: $s = "Weekly" $t = "Weeakly"
Output: "a"
Example 3
Input: $s = "Box" $t = "Boxy"
Output: "y"
```

I can count each character using a hash, up for the string $t and down for the string $s, and look for the odd character with a count of -1. I simplify the code by deleting the entries with a count of 0, so I get all odd characters, in case there are more than one. This fits a oneliner:

Example 1:

```
perl -E '
($t,$s)=@ARGV; ++$c{$_} for split "", fc $t; --$c{$_}||delete $c{$_} for split "", fc $s; say "$t, $s -> ", keys %c;
' Perl Preel
```

Results:

```
Perl, Preel -> e
```

Example 2:

```
perl -E '
($t,$s)=@ARGV; ++$c{$_} for split "", fc $t; --$c{$_}||delete $c{$_} for split "", fc $s; say "$t, $s -> ", keys %c;
' Weekly Weeakly
```

Results:

```
Weekly, Weeakly -> a
```

Example 3:

```
perl -E '
($t,$s)=@ARGV; ++$c{$_} for split "", fc $t; --$c{$_}||delete $c{$_} for split "", fc $s; say "$t, $s -> ", keys %c;
' Box Boxy
```

Results:

```
Box, Boxy -> y
```

For the full code I use `for_list`

and add some tests:

```
1 # Perl weekly challenge 255
2 # Task 1: Odd Character
3 #
4 # See https://wlmb.github.io/2024/02/05/PWC255/#task-1-odd-character
5 use v5.36;
6 use experimental qw(for_list);
7 die <<~"FIN" unless @ARGV && @ARGV%2==0;
8 Usage: $0 S0 T0 [S1 T1...]
9 to find the odd characters in the string pairs Sn Tn
10 FIN
11 for my ($s,$t)(@ARGV){
12 warn "Length should differ by one" unless length $t == 1+length $s;
13 my %count;
14 ++$count{$_} for split "", fc $s;
15 --$count{$_}||delete $count{$_} for split "", fc $t;
16 warn "More than one odd character" unless (keys %count)==1;
17 say "$t, $s -> ", keys %count;
18 }
```

Examples:

```
./ch-1.pl Perl Preel Weekly Weeakly Box Boxy
```

Results:

```
Perl, Preel -> e
Weekly, Weeakly -> a
Box, Boxy -> y
```

```
Submitted by: Mohammad Sajid Anwar
You are given a paragraph $p and a banned word $w.
Write a script to return the most frequent word that is not banned.
Example 1
Input: $p = "Joe hit a ball, the hit ball flew far after it was hit."
$w = "hit"
Output: "ball"
The banned word "hit" occurs 3 times.
The other word "ball" occurs 2 times.
Example 2
Input: $p = "Perl and Raku belong to the same family. Perl is the
most popular language in the weekly challenge."
$w = "the"
Output: "Perl"
The banned word "the" occurs 3 times.
The other word "Perl" occurs 2 times.
```

I can count all words with a hash, delete the banned entry and then
find that with the largest frequency. I use `max_by`

from
`List::UtilsBy`

or `List::AllUtils`

. I split the paragraph on non-word
characters. This yields a one and a half liner:

Example 1:

```
perl -MList::UtilsBy=max_by -E '
($w, $p)=@ARGV; ++$c{fc $_} for split /\W+/, $p; delete $c{fc $w};
say "$w\n$p\n->\n", max_by{$c{$_}} keys %c;
' hit "Joe hit a ball, the hit ball flew far after it was hit."
```

Results:

```
hit
Joe hit a ball, the hit ball flew far after it was hit.
->
ball
```

Example 2:

```
perl -MList::UtilsBy=max_by -E '
($w, $p)=@ARGV; ++$c{fc $_} for split /\W+/, $p; delete $c{$w};
say "$w\n$p\n->\n", max_by{$c{$_}} keys %c;
' the \
"Perl and Raku belong to the same family. Perl is the
most popular language in the weekly challenge."
```

Results:

```
the
Perl and Raku belong to the same family. Perl is the
most popular language in the weekly challenge.
->
perl
```

The full code is similar:

```
1 # Perl weekly challenge 255
2 # Task 2: Most Frequent Word
3 #
4 # See https://wlmb.github.io/2024/02/05/PWC255/#task-2-most-frequent-word
5 use v5.36;
6 use List::UtilsBy qw(max_by);
7 die <<~"FIN" unless @ARGV==2;
8 Usage: $0 S ¨P
9 to find the most frequent word in paragraph P excluding the word S
10 FIN
11 my ($w, $p)=@ARGV;
12 my %count;
13 ++$count{fc $_} for split /\W+/, $p;
14 delete $count{fc $w};
15 say "\n$w\n$p\n->\n", max_by{$count{$_}} keys %count;
```

Examples:

```
./ch-2.pl hit "Joe hit a ball, the hit ball flew far after it was hit."
./ch-2.pl the \
"Perl and Raku belong to the same family. Perl is the
most popular language in the weekly challenge."
```

Results:

```
hit
Joe hit a ball, the hit ball flew far after it was hit.
->
ball
the
Perl and Raku belong to the same family. Perl is the
most popular language in the weekly challenge.
->
perl
```

/;

]]>```
Submitted by: Mohammad S Anwar
You are given a positive integer, $n.
Write a script to return true if the given integer is a power of three,
otherwise return false.
Example 1
Input: $n = 27
Output: true
27 = 3 ^ 3
Example 2
Input: $n = 0
Output: true
0 = 0 ^ 3
Example 3
Input: $n = 6
Output: false
```

(I interpret power of three as $n**3, not as 3**$n; otherwise I guess example 2 would be wrong.) An interesting solution would be to find the factors of the number and then check that their multiplicity is a multiple of three. But a quick and dirty solution is to simply take the cubic root, round it to an integer and check its third power equals the original number. This yields a simple oneliner.

Examples:

```
perl -MPOSIX=lround -E 'for(@ARGV){say "$_ -> ", $_==lround($_**(1/3))**3?"True":"False"}' 27 0 6
```

Results:

```
27 -> True
0 -> True
6 -> False
```

Curiously, the code above fails for negative numbers:

```
perl -MPOSIX=lround -E 'for(@ARGV){say "$_ -> ", $_==lround($_**(1/3))**3?"True":"False"}' -- -27
```

Results:

```
-27 -> False
```

The reason is that fractional powers of negative numbers are tricky. The solution is trivial, as (-1)**3=(-1); I simply take the absolute value.

```
perl -MPOSIX=lround -E 'for(@ARGV){say "$_ -> ", abs($_)==lround(abs($_)**(1/3))**3?"True":"False"}
' -- -27
```

Results:

```
-27 -> True
```

The full code is:

```
1 # Perl weekly challenge 254
2 # Task 1: Three Power
3 #
4 # See https://wlmb.github.io/2024/01/29/PWC254/#task-1-three-power
5 use v5.36;
6 use POSIX qw(lround);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to check if the integers N1 N2... are cubes
10 FIN
11 for(@ARGV){
12 warn("$_ not integer"),next unless $_ == lround($_);
13 say "$_ -> ", abs($_)==lround(abs($_)**(1/3))**3?"True":"False";
14 }
```

Examples:

```
./ch-1.pl 27 0 6 -27
```

Results:

```
27 -> True
0 -> True
6 -> False
-27 -> True
```

```
Submitted by: Mohammad S Anwar
You are given a string, $s.
Write a script to reverse all the vowels (a, e, i, o, u) in the given string.
Example 1
Input: $s = "Raku"
Output: "Ruka"
Example 2
Input: $s = "Perl"
Output: "Perl"
Example 3
Input: $s = "Julia"
Output: "Jaliu"
Example 4
Input: $s = "Uiua"
Output: "Auiu"
```

I can split the string into an array, make an array of the indices of
its vowels and use it to assign the reversed vowels to the positions
occupied by the original vowels. To be consistent with the examples, I
`lc`

the input and `ucfirst`

the output. This yields a one and a half liner,
assuming ASCII input.

Examples:

```
perl -E '
for(@ARGV){@x=split "", lc $_; @i=grep {$x[$_]=~/[aeiou]/}(0..@x-1); @x[@i]=reverse @x[@i];
say "$_ -> ", ucfirst join "", @x;}
' Raku Perl Julia Uiua
```

Results:

```
Raku -> Ruka
Perl -> Perl
Julia -> Jaliu
Uiua -> Auiu
```

The full code follows:

```
1 # Perl weekly challenge 254
2 # Task 2: Reverse Vowels
3 #
4 # See https://wlmb.github.io/2024/01/29/PWC254/#task-2-reverse-vowels
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 W1 [W2..]
8 to reverse the vowels in the words W1 W2...
9 FIN
10 for(@ARGV){
11 my @all = split "", lc $_;
12 my @vowel_indices=grep {$all[$_]=~/[aeiou]/} 0..@all-1;
13 @all[@vowel_indices]=reverse @all[@vowel_indices];
14 my $out=ucfirst join "", @all;
15 say "$_ -> $out";
16 }
```

Example:

```
./ch-2.pl Raku Perl Julia Jaiu Uiua
```

Results:

```
Raku -> Ruka
Perl -> Perl
Julia -> Jaliu
Jaiu -> Juia
Uiua -> Auiu
```

/;

]]>```
Submitted by: Mohammad S Anwar
You are given an array of strings and a character separator.
Write a script to return all words separated by the given character
excluding empty string.
Example 1
Input: @words = ("one.two.three","four.five","six")
$separator = "."
Output: "one","two","three","four","five","six"
Example 2
Input: @words = ("$perl$$", "$$raku$")
$separator = "$"
Output: "perl","raku"
```

Perl has a `split`

operator that fits nicely into this task. The
problem is that the separator may be interpreted as a special
character within a regular expression. Thus, I escape it with slashes
when constructing the argument of split. I further filter out empty
strings with `grep`

. The results fit a oneliner.

Example 1:

```
perl -E '
$s=shift; @x=@ARGV; push @r, grep {/./} split /[$s]/ for(@x); say "sep: $s, in: @x => @r"
' . one.two.three four.five six
```

Results:

```
sep: ., in: one.two.three four.five six => one two three four five six
```

Example 2:

```
perl -E '
$s=shift; @x=@ARGV; push @r, grep {/./} split /[$s]/ for(@x); say "sep: $s, in: @x => @r"
' '$' '$perl$$' '$$raku$'
```

Results:

```
sep: $, in: $perl$$ $$raku$ => perl raku
```

Full code:

```
1 # Perl weekly challenge 253
2 # Task 1: Split Strings
3 #
4 # See https://wlmb.github.io/2024/01/22/PWC253/#task-1-split-strings
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S W1 [W2...]
8 to separate words W1 W2... at separator character S.
9 FIN
10 my $separator = shift;
11 die "Only single characterr allowed as separator: $separator" unless $separator=~/^.$/;
12 my @results;
13 push @results, grep {/./} split /[$separator]/ for (@ARGV);
14 say "Separator: $separator, input: @ARGV => output: @results";
```

Examples:

```
./ch-1.pl . one.two.three four.five six
./ch-1.pl '$' '$perl$$' '$$raku$'
```

Results:

```
Separator: ., input: one.two.three four.five six => output: one two three four five six
Separator: $, input: $perl$$ $$raku$ => output: perl raku
```

```
Submitted by: Mohammad S Anwar
You are given an m x n binary matrix i.e. only 0 and 1 where 1 always appear before 0.
A row i is weaker than a row j if one of the following is true:
a. The number of 1s in row i is less than the number of 1s in row j.
b. Both rows have the same number of 1 and i < j.
Write a script to return the order of rows from weakest to strongest.
Example 1
Input: $matrix = [
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 0],
[1, 0, 0, 0, 0],
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 1]
]
Output: (2, 0, 3, 1, 4)
The number of 1s in each row is:
- Row 0: 2
- Row 1: 4
- Row 2: 1
- Row 3: 2
- Row 4: 5
Example 2
Input: $matrix = [
[1, 0, 0, 0],
[1, 1, 1, 1],
[1, 0, 0, 0],
[1, 0, 0, 0]
]
Output: (0, 2, 3, 1)
The number of 1s in each row is:
- Row 0: 1
- Row 1: 4
- Row 2: 1
- Row 3: 1
```

I can input each row as a binary string, `split`

into and array and
`sort`

its row indices by the sum of its members and by the indices
themselves. The result fits a two-liner.

Example 1:

```
perl -MList::Util=sum0 -E '
push @x, [split ""] for(@ARGV); say p(@x), "\n-> ", join " ", sort{f($a)<=>f($b)||$a<=>$b}
0..@x-1; sub p(@m){return "[\n", (map {" [ @$_ ]\n"} @m), "]"} sub f($i){sum0 $x[$i]->@*}
' 11000 11110 10000 11000 11111
```

Results:

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

Example 2:

```
perl -MList::Util=sum0 -E '
push @x, [split ""] for(@ARGV); say p(@x), "\n-> ", join " ", sort{f($a)<=>f($b)||$a<=>$b}
0..@x-1; sub p(@m){return "[\n", (map {" [ @$_ ]\n"} @m), "]"} sub f($i){sum0 $x[$i]->@*}
' 1000 1111 1000 1000
```

Results:

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

The full code adds a few checks and uses a Schwartzian transform to avoid recomputing sums (and get fancy):

```
1 # Perl weekly challenge 253
2 # Task 2: Weakest Row
3 #
4 # See https://wlmb.github.io/2024/01/22/PWC253/#task-2-weakest-row
5 use v5.36;
6 use List::Util qw(all sum0);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 R0 [R1...]
9 to order the indices of the rows R_i of a binary matrix
10 from weakest to strongest, where R_i is represented as
11 a binary string.
12 FIN
13 die "Only binary strings allowed" unless all {m/^[01]+$/} @ARGV;
14 my @matrix;
15 push @matrix, [split ""] for(@ARGV);
16 say format_matrix(@matrix), "\n-> ",
17 join " ",
18 map {$_->[0]}
19 sort {$a->[1] <=> $b->[1] || $a->[0] <=> $b->[0]}
20 map {[$_, sum0 $matrix[$_]->@*]}
21 0..@matrix-1;
22 sub format_matrix(@m){
23 return "[\n", (map {" [ @$_ ]\n"} @m), "]"
24 }
```

Examples:

```
./ch-2.pl 11000 11110 10000 11000 11111
./ch-2.pl 1000 1111 1000 1000
```

Results:

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

/;

]]>```
Submitted by: Mohammad S Anwar
You are given an array of integers, @ints.
Write a script to find the sum of the squares of all special elements of the
given array.
An element $int[i] of @ints is called special if i divides n, i.e. n % i == 0.
Where n is the length of the given array. Also the array is 1-indexed
for the task.
Example 1
Input: @ints = (1, 2, 3, 4)
Output: 21
There are exactly 3 special elements in the given array:
$ints[1] since 1 divides 4,
$ints[2] since 2 divides 4, and
$ints[4] since 4 divides 4.
Hence, the sum of the squares of all special elements of given array:
1 * 1 + 2 * 2 + 4 * 4 = 21.
Example 2
Input: @ints = (2, 7, 1, 19, 18, 3)
Output: 63
There are exactly 4 special elements in the given array:
$ints[1] since 1 divides 6,
$ints[2] since 2 divides 6,
$ints[3] since 3 divides 6, and
$ints[6] since 6 divides 6.
Hence, the sum of the squares of all special elements of given array:
2 * 2 + 7 * 7 + 1 * 1 + 3 * 3 = 63
```

A simple solution consists of filtering all possible indices,
searching for divisors of the length of the array, and then squaring
an adding the corresponding array elements. This may be done with a
combination of `grep`

, `map`

and `sum0`

. It all fits a oneliner.

Example 1:

```
perl -MList::Util=sum0 -E '@x=@ARGV;say "@x -> ", sum0 map{$x[$_-1]**2} grep {@x%$_==0} 1..@x;' 1 2 3 4
```

Results:

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

Example 2:

```
perl -MList::Util=sum0 -E '@x=@ARGV;say "@x -> ", sum0 map{$x[$_-1]**2} grep {@x%$_==0} 1..@x;
' 2 7 1 19 18 3
```

Results:

```
2 7 1 19 18 3 -> 63
```

The full code is essentially the same:

```
1 # Perl weekly challenge 252
2 # Task 1: Special Numbers
3 #
4 # See https://wlmb.github.io/2024/01/15/PWC252/#task-1-special-numbers
5 use v5.36;
6 use List::Util qw(sum0);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to sum the squares of the special elements of N1 N2...
10 FIN
11 say "@ARGV -> ", sum0 map {$ARGV[$_-1]**2} grep {@ARGV%$_==0} 1..@ARGV;
```

Examples:

```
./ch-1.pl 1 2 3 4
./ch-1.pl 2 7 1 19 18 3
```

Results:

```
1 2 3 4 -> 21
2 7 1 19 18 3 -> 63
```

```
Submitted by: Mohammad S Anwar
You are given an integer, $n.
Write a script to find an array containing $n unique integers such that
they add up to zero.
Example 1
Input: $n = 5
Output: (-7, -1, 1, 3, 4)
Two other possible solutions could be as below:
(-5, -1, 1, 2, 3) and (-3, -1, 2, -2, 4).
Example 2
Input: $n = 3
Output: (-1, 0, 1)
Example 3
Input: $n = 1
Output: (0)
```

I’m not quite sure I understood this problem, as there are many very simple
solutions. For example, one could take any set of `N-1`

distinct positive
numbers and add as the las element their sum with a minus sign. Thus
I’ll add a
little constraint, namely, to obtain the smaller possible solution, in
the sense that the sum of the absolute values is minimum (assuming
integer numbers). This is
easily solved also. For `N=1`

the solution ls `[0]`

, for `N=2`

it is
`[-1,1]`

. For arbitrary `N`

, I can solve the problem for `N-2`

and
then add `±N/2`

. Equivalently, the solution is
`-N/2,-N/2+1...N/2-1,N/2`

including 0 once if `N`

is odd and excluding
it if even.

Example 1

```
perl -E '$n=shift; say "$n -> [", join(" ", -$n/2..-1, $n%2?(0):(), 1..$n/2), "]"' 5
```

Results:

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

Example 2

```
perl -E '$n=shift; say "$n -> [", join(" ", -$n/2..-1, $n%2?(0):(), 1..$n/2), "]"' 3
```

Results:

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

Example 3

```
perl -E '$n=shift; say "$n -> [", join(" ", -$n/2..-1, $n%2?(0):(), 1..$n/2), "]"' 1
```

Results:

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

Another example:

```
perl -E '$n=shift; say "$n -> [", join(" ", -$n/2..-1, $n%2?(0):(), 1..$n/2), "]"' 6
```

Results:

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

The full code is similar.

```
1 # Perl weekly challenge 252
2 # Task 2: Unique Sum Zero
3 #
4 # See https://wlmb.github.io/2024/01/15/PWC252/#task-2-unique-sum-zero
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 [N2...]
8 to obtain arrays of N_j numbers that add up to zero.
9 FIN
10 for(@ARGV){
11 warn("Input must be greater than one"), next unless $_>=1;
12 say "$_ -> [", join(" ", -$_/2..-1, $_%2?(0):(), 1..$_/2), "]";
13 }
```

Examples:

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

Results:

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

```
Submitted by: Mohammad S Anwar
You are given an array of integers, @ints.
Write a script to find the concatenation value of the given array.
The concatenation of two numbers is the number formed by concatenating their
numerals.
For example, the concatenation of 10, 21 is 1021.
The concatenation value of @ints is initially equal to 0.
Perform this operation until @ints becomes empty:
If there exists more than one number in @ints, pick the first element
and last element in @ints respectively and add the value of their
concatenation to the concatenation value of @ints, then delete the
first and last element from @ints.
If one element exists, add its value to the concatenation value of
@ints, then delete it.
Example 1
Input: @ints = (6, 12, 25, 1)
Output: 1286
1st operation: concatenation of 6 and 1 is 61
2nd operation: concaternation of 12 and 25 is 1225
Concatenation Value => 61 + 1225 => 1286
Example 2
Input: @ints = (10, 7, 31, 5, 2, 2)
Output: 489
1st operation: concatenation of 10 and 2 is 102
2nd operation: concatenation of 7 and 2 is 72
3rd operation: concatenation of 31 and 5 is 315
Concatenation Value => 102 + 72 + 315 => 489
Example 3
Input: @ints = (1, 2, 10)
Output: 112
1st operation: concatenation of 1 and 10 is 110
2nd operation: only element left is 2
Concatenation Value => 110 + 2 => 112
```

Perl nicely converts strings, which may be concatenated, to numbers, which may be added. Furthermore, an undef string is conveniently interpreted as a null string (when we are not strict). The shift and pop operators allow taking the first and las elements our of an array. These allow an extremely compact one-liner:

Example 1:

```
perl -E '@x=@ARGV; $tot+=shift(@x).pop(@x) while(@x); say "@ARGV -> $tot"' 6 12 25 1
```

Results:

```
6 12 25 1 -> 1286
```

Example 2:

```
perl -E '@x=@ARGV; $tot+=shift(@x).pop(@x) while(@x); say "@ARGV -> $tot"' 10 7 31 5 2 2
```

Results:

```
10 7 31 5 2 2 -> 489
```

Example 3:

```
perl -E '@x=@ARGV; $tot+=shift(@x).pop(@x) while(@x); say "@ARGV -> $tot"' 1 2 10
```

Results:

```
1 2 10 -> 112
```

The full code is slightly more careful for the case of an odd number of elements:

```
1 # Perl weekly challenge 251
2 # Task 1: Concatenation Value
3 #
4 # See https://wlmb.github.io/2024/01/08/PWC251/#task-1-concatenation-value
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 [N2...]
8 to concatenate and add the numbers N_1 . N_k + N_2 . N_{k-1} +...
9 FIN
10 my $tot=0;
11 my @ints=@ARGV;
12 $tot += shift(@ints).(pop(@ints)//"") while(@ints);
13 say "@ARGV -> $tot";
```

Examples:

```
./ch-1.pl 6 12 25 1
./ch-1.pl 10 7 31 5 2 2
./ch-1.pl 1 2 10
```

Results:

```
6 12 25 1 -> 1286
10 7 31 5 2 2 -> 489
1 2 10 -> 112
```

```
Submitted by: Mohammad S Anwar
You are given a m x n matrix of distinct numbers.
Write a script to return the lucky number, if there is one, or -1 if not.
A lucky number is an element of the matrix such that it is
the minimum element in its row and maximum in its column.
Example 1
Input: $matrix = [ [ 3, 7, 8],
[ 9, 11, 13],
[15, 16, 17] ];
Output: 15
15 is the only lucky number since it is the minimum in its row
and the maximum in its column.
Example 2
Input: $matrix = [ [ 1, 10, 4, 2],
[ 9, 3, 8, 7],
[15, 16, 17, 12] ];
Output: 12
Example 3
Input: $matrix = [ [7 ,8],
[1 ,2] ];
Output: 7
```

I use `pdl`

to manage the matrix. It has the functions `maxover`

and
`minover`

to find the maximum and minimum values over a row. It also
has `mv`

to convert rows into columns and viceversa. It has `dummy`

to
convert vectors into matrices. Finally it
provides `which`

to find out which elements satisfy a given
condition. This allows a very compact solution.

Examples:

```
perl -MPDL -E 'while(@ARGV){$x=pdl(shift);
say "$x -> ",$x->where(($x==$x->minover->dummy(0))&($x==$x->mv(1,0)->maxover->dummy(1)))}
' "[[3 7 8],[9 11 13],[15 16 17]]" "[[1 10 4 2],[9 3 8 7],[15 16 17 12]]" "[[7 8],[1 2]]"
```

Results:

```
[
[ 3 7 8]
[ 9 11 13]
[15 16 17]
]
-> [15]
[
[ 1 10 4 2]
[ 9 3 8 7]
[15 16 17 12]
]
-> [12]
[
[7 8]
[1 2]
]
-> [7]
```

This returns an empty ndarray when no lucky number is found.

```
perl -MPDL -E 'while(@ARGV){$x=pdl(shift);
say "$x -> ",$x->where(($x==$x->minover->dummy(0))&($x==$x->mv(1,0)->maxover->dummy(1)))}
' "[[1 3],[4 2]]"
```

Results:

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

The full code adds checks and tests for empty results:

```
1 # Perl weekly challenge 251
2 # Task 2: Lucky Numbers
3 #
4 # See https://wlmb.github.io/2024/01/08/PWC251/#task-2-lucky-numbers
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 A1 [A2...]
9 to find lucky numbers in the arrays A1, A2...
10 The format of the arrays should be "[[a00 a01...],[a10 a11...],...]",
11 to be read by pdl.
12 FIN
13 while(@ARGV){
14 my $in=pdl(shift);
15 my $min=$in->minover->dummy(0);
16 my $max=$in->mv(1,0)->maxover->dummy(1);
17 my $result=$in->where(($in==$min)&($in==$max));
18 say "$in -> ", $result->isempty?-1:$result;
19 }
```

Examples:

```
./ch-2.pl "[[3 7 8],[9 11 13],[15 16 17]]" "[[1 10 4 2],[9 3 8 7],[15 16 17 12]]"\
"[[7 8],[1 2]]" "[[1 3],[4 2]]"
```

Results:

```
[
[ 3 7 8]
[ 9 11 13]
[15 16 17]
]
-> [15]
[
[ 1 10 4 2]
[ 9 3 8 7]
[15 16 17 12]
]
-> [12]
[
[7 8]
[1 2]
]
-> [7]
[
[1 3]
[4 2]
]
-> -1
```

/;

]]>It’s the first time I participate. It took quite some time but it was fun and I learned quite a bit. Maybe my programs are not too efficient nor the solutions too clever, but it was fun to figure them out all before checking the solutions of other’s. My analysis of the problems is here. For the analysis of each day’s problems:

- Day 1
- Day 2
- Day 3
- Day 4
- Day 5
- Day 6
- Day 7
- Day 8
- Day 9
- Day 10
- Day 11
- Day 12
- Day 13
- Day 14
- Day 15
- Day 16
- Day 17
- Day 18
- Day 19
- Day 20
- Day 21
- Day 22
- Day 23
- Day 24
- Day 25

The Perl programs are at:

- Day 1 task 1 Day 1 task 2
- Day 2 task 1 Day 2 task 2
- Day 3 task 1 Day 3 task 2
- Day 4 task 1 Day 4 task 2
- Day 5 task 1 Day 5 task 2
- Day 6 task 1 Day 6 task 2
- Day 7 task 1 Day 7 task 2
- Day 8 task 1 Day 8 task 2
- Day 9 task 1 Day 9 task 2
- Day 10 task 1 Day 0 task 2
- Day 11 task 1 Day 11 task 2
- Day 12 task 1 Day 12 task 2
- Day 13 task 1 Day 13 task 2
- Day 14 task 1 Day 14 task 2
- Day 15 task 1 Day 15 task 2
- Day 16 task 1 Day 6 task 2
- Day 17 task 1 Day 17 task 2
- Day 18 task 1 Day 8 task 2
- Day 19 task 1 Day 19 task 2
- Day 20 task 1 Day 20 task 2
- Day 21 task 1 Day 21 task 2
- Day 22 task 1 Day 22 task 2
- Day 23 task 1 Day 23 task 2
- Day 24 task 1 Day 24 task 2
- Day 25 task 1

Their timing is here. All of the tasks ran one after the other in about 36mins in a single core of an old Dell laptop.

]]>```
Submitted by: Mohammad S Anwar
You are given an array of integers, @ints.
Write a script to find the smallest index i such that i mod 10 == $ints[i]
otherwise return -1.
Example 1
Input: @ints = (0, 1, 2)
Output: 0
i=0: 0 mod 10 = 0 == $ints[0].
i=1: 1 mod 10 = 1 == $ints[1].
i=2: 2 mod 10 = 2 == $ints[2].
All indices have i mod 10 == $ints[i], so we return the smallest index 0.
Example 2
Input: @ints = (4, 3, 2, 1)
Output: 2
i=0: 0 mod 10 = 0 != $ints[0].
i=1: 1 mod 10 = 1 != $ints[1].
i=2: 2 mod 10 = 2 == $ints[2].
i=3: 3 mod 10 = 3 != $ints[3].
2 is the only index which has i mod 10 == $ints[i].
Example 3
Input: @ints = [1, 2, 3, 4, 5, 6, 7, 8, 9, 0]
Output: -1
Explanation: No index satisfies i mod 10 == $ints[i].
```

Straightforward one-liner, just follow the description using `first`

from `List::Util`

.

Example 1:

```
perl -MList::Util=first -E '@x=@ARGV; say "@x -> ", (first {$x[$_]%10==$_} @x)//-1' 0 1 2
```

Results:

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

Example 2:

```
perl -MList::Util=first -E '@x=@ARGV; say "@x -> ", (first {$x[$_]%10==$_} @x)//-1' 4 3 2 1
```

Results:

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

Example 3:

```
perl -MList::Util=first -E '@x=@ARGV; say "@x -> ", (first {$x[$_]%10==$_} @x)//-1' 1 2 3 4 5 6 7 8 9 0
```

Results:

```
1 2 3 4 5 6 7 8 9 0 -> -1
```

The full code is almost identical.

```
1 # Perl weekly challenge 250
2 # Task 1: Smallest Index
3 #
4 # See https://wlmb.github.io/2024/01/01/PWC250/#task-1-smallest-index
5 use v5.36;
6 use List::Util qw(first);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N0 [N1...]
9 to find first index i for which N_i%10==i
10 FIN
11 say "@ARGV -> ", (first {$ARGV[$_]%10==$_} @ARGV)//-1;
```

Examples:

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

Results:

```
0 1 2 -> 0
4 3 2 1 -> 2
1 2 3 4 5 6 7 8 9 0 -> -1
```

```
Submitted by: Mohammad S Anwar
You are given an array of alphanumeric strings.
Write a script to return the maximum value of alphanumeric string
in the given array.
The value of alphanumeric string can be defined as
a. The numeric representation of the string in base 10 if it is made up
of digits only.
b. otherwise the length of the string
Example 1
Input: @alphanumstr = ("perl", "2", "000", "python", "r4ku")
Output: 6
"perl" consists of letters only so the value is 4.
"2" is digits only so the value is 2.
"000" is digits only so the value is 0.
"python" consits of letters so the value is 6.
"r4ku" consists of letters and digits so the value is 4.
Example 2
Input: @alphanumstr = ("001", "1", "000", "0001")
Output: 1
```

Again, straightforward solution by just following the directions. I allow a sign in the numeric values.

Example 1:

```
perl -MList::Util=max -E '
@x=@ARGV; say "@x -> ", max map {/^[+-]?\d+$/?0+$_:length $_} @x;' perl 2 000 python r4ku
```

Results:

```
perl 2 000 python r4ku -> 6
```

Example 2:

```
perl -MList::Util=max -E '
@x=@ARGV; say "@x -> ", max map {/^[+-]?\d+$/?0+$_:length $_} @x;' 001 1 000 0001
```

Results:

```
001 1 000 0001 -> 1
```

The full code is identical:

```
1 # Perl weekly challenge 250
2 # Task 2: Alphanumeric String Value
3 #
4 # See https://wlmb.github.io/2024/01/01/PWC250/#task-2-alphanumeric-string-value
5 use v5.36;
6 use List::Util qw(max);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S0 [S1...]
9 to find the maximum \"value\" of the strings S0 S1...
10 FIN
11 say "@ARGV -> ", max map {/^[+-]?\d+$/?0+$_:length $_} @ARGV;
```

Examples:

```
./ch-2.pl perl 2 000 python r4ku
./ch-2.pl 001 1 000 0001
```

Results:

```
perl 2 000 python r4ku -> 6
001 1 000 0001 -> 1
```

/;

]]>```
Submitted by: Mohammad S Anwar
You are given an array of integers with even number of elements.
Write a script to divide the given array into equal pairs such that:
a. Each element belongs to exactly one pair.
b. The elements present in a pair are equal.
Example 1
Input: @ints = (3, 2, 3, 2, 2, 2)
Output: (2, 2), (3, 3), (2, 2)
There are 6 elements in @ints.
They should be divided into 6 / 2 = 3 pairs.
@ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying
all the conditions.
Example 2
Input: @ints = (1, 2, 3, 4)
Output: ()
There is no way to divide @ints 2 pairs such that the pairs satisfy
every condition.
```

I can count how many times each number appears and if all of them are even, output the corresponding pairs. This fits a one and a half liner.

Example 1:

```
perl -MList::Util=all -E '
$c{$_}++ for @ARGV; say "(@ARGV) => ", (all {$_%2==0} values %c)?
map {("($_ $_) ") x ($c{$_}/2)} keys %c:"()"
' 3 2 3 2 2 2
```

Results:

```
(3 2 3 2 2 2) => (2 2) (2 2) (3 3)
```

Example 2:

```
perl -MList::Util=all -E '
$c{$_}++ for @ARGV; say "(@ARGV) => ", (all {$_%2==0} values %c)?
map {("($_ $_) ") x ($c{$_}/2)} keys %c:"()"
' 1 2 3 4
```

Results:

```
(1 2 3 4) => ()
```

The full code is:

```
1 # Perl weekly challenge 249
2 # Task 1: Equal Pairs
3 #
4 # See https://wlmb.github.io/2023/12/25/PWC249/#task-1-equal-pairs
5 use v5.36;
6 use List::Util qw(all);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to find pairs of equal numbers N_i == N_j
10 FIN
11 my %count;
12 $count{$_}++ for @ARGV;
13 say "(@ARGV) => ",
14 (all {$_%2==0} values %count)
15 ? map {("($_ $_) ") x ($count{$_}/2)} sort {$a<=>$b} keys %count:"()"
```

Examples:

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

Results:

```
(2 3 3 2 2 2) => (2 2) (2 2) (3 3)
(1 2 3 4) => ()
```

```
Submitted by: Mohammad S Anwar
You are given a string s, consisting of only the characters "D" and "I".
Find a permutation of the integers [0 .. length(s)] such that for each
character s[i] in the string:
s[i] == 'I' ⇒ perm[i] < perm[i + 1]
s[i] == 'D' ⇒ perm[i] > perm[i + 1]
Example 1
Input: $str = "IDID"
Output: (0, 4, 1, 3, 2)
Example 2
Input: $str = "III"
Output: (0, 1, 2, 3)
Example 3
Input: $str = "DDI"
Output: (3, 2, 0, 1)
```

A simple solution is to start a sequence at 0, for every I increase update the maximum and append it to the sequence, and for every D decrease the minimum and append it to the sequence. Finally, subtract the minimum from all the elements. This yields a one and a half liner.

Examples:

```
perl -E '
for(@ARGV){my @o;push @o,$M=$m=0;push @o, ($_ eq "I")?++$M:--$m for split "";
say "$_ => (",join(",", map {$_-$m} @o), ")"}
' IDID III DDI
```

Results:

```
IDID => (2,3,1,4,0)
III => (0,1,2,3)
DDI => (2,1,0,3)
```

I believe these results are correct but they are not unique, and they don’t always agree with those shown in the description of the challenge. A similar solution may be obtained by reversing the string, the meaning of D and I and then reversing the result.

```
perl -E '
for(@ARGV){my @o;push @o,$M=$m=0;push @o, ($_ eq "D")?++$M:--$m for reverse split "";
say "$_ => (",join(",", reverse map {$_-$m} @o), ")"}
' IDID III DDI
```

Results:

```
IDID => (0,4,1,3,2)
III => (0,1,2,3)
DDI => (3,2,0,1)
```

The full code is:

```
1 # Perl weekly challenge 249
2 # Task 2: DI String Match
3 #
4 # See https://wlmb.github.io/2023/12/25/PWC249/#task-2-di-string-match
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S1 [S2...]
8 where S_i is a string of D's and I's, to produce a permutation of
9 indices 0..length of S_i that increases or decreases according to
10 the letters D or I.
11 FIN
12 for(@ARGV){
13 warn("Only D's and I's allowed: $_"), next unless /^[DI]+$/;
14 my @output;
15 push @output,my $max=my $min=0;
16 push @output, ($_ eq "D")?++$max:--$min for reverse split "";
17 say "$_ => (",join(",", reverse map {$_-$min} @output), ")"
18 }
```

Examples:

```
./ch-2.pl IDID III DDI
```

Results:

```
IDID => (0,4,1,3,2)
III => (0,1,2,3)
DDI => (3,2,0,1)
```

/;

]]>