Perl Weekly Challenge 271.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 271.

``````Submitted by: Mohammad Sajid Anwar
You are given a m x n binary matrix.

Write a script to return the row number containing maximum ones, in case of
more than one rows then return smallest row number.

Example 1
Input: \$matrix = [ [0, 1],
[1, 0],
]
Output: 1

Row 1 and Row 2 have the same number of ones, so return row 1.
Example 2
Input: \$matrix = [ [0, 0, 0],
[1, 0, 1],
]
Output: 2

Row 2 has the maximum ones, so return row 2.
Example 3
Input: \$matrix = [ [0, 0],
[1, 1],
[0, 0],
]
Output: 2

Row 2 have the maximum ones, so return row 2.
``````

I can compare the array elements with 1, sum over rows, sort with both criteria and choose the first element. I use the Perl Data Language (PDL) to read the arrays and count ones. Then I convert them to ordinary Perl arrays to continue processing. The results fits a one-liner.

Example 1:

``````perl -MPDL  -E '
\$x=pdl(shift);@o=(\$x==1)->sumover->dog;@r=sort{\$o[\$b]<=>\$o[\$a]||\$a<=>\$b}0..@o-1;say "\$x -> ",1+\$r[0]
' "[0 1][1 0]]"
``````

Results:

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

Example 2:

``````perl -MPDL  -E '
\$x=pdl(shift);@o=(\$x==1)->sumover->dog;@r=sort{\$o[\$b]<=>\$o[\$a]||\$a<=>\$b}0..@o-1;say "\$x -> ",1+\$r[0]
' "[[0 0 0][1 0 1]]"
``````

Results:

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

Example 3:

``````perl -MPDL  -E '
\$x=pdl(shift);@o=(\$x==1)->sumover->dog;@r=sort{\$o[\$b]<=>\$o[\$a]||\$a<=>\$b}0..@o-1;say "\$x -> ",1+\$r[0]
' "[[0 0][1 1][0 0]]"
``````

Results:

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

The full code is similar:

`````` 1  # Perl weekly challenge 271
2  # Task 1:  Maximum Ones
3  #
5  use v5.36;
6  use PDL;
7  die <<~"FIN" unless @ARGV;
8      Usage: \$0 [[m11 m12...][m21 m22...]...]
9      to find the row with the largest number of 1 entries,
10      or the first largest row in case of a tie.
11      Rows are numbered from 1 upwards.
12      FIN
13  for(@ARGV){
14      my \$in=pdl(\$_);
15      my @ones=(\$in==1)->sumover->dog; # ones in each row
16      my @sorted=sort {\$ones[\$b] <=> \$ones[\$a] || \$a<=>\$b} 0..@ones-1;
17      say "\$in -> ",1+\$sorted[0];
18  }
``````

Examples:

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

Results:

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

[
[0 0 0]
[1 0 1]
]
-> 2

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

Task 2: Sort by 1 bits

``````Submitted by: Mohammad Sajid Anwar
You are give an array of integers, @ints.

Write a script to sort the integers in ascending order by the number of
1 bits in their binary representation. In case more than one integers
have the same number of 1 bits then sort them in ascending order.

Example 1
Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)

0 = 0 one bits
1 = 1 one bits
2 = 1 one bits
4 = 1 one bits
8 = 1 one bits
3 = 2 one bits
5 = 2 one bits
6 = 2 one bits
7 = 3 one bits
Example 2
Input: @ints = (1024, 512, 256, 128, 64)
Output: (64, 128, 256, 512, 1024)

All integers in the given array have one 1-bits, so just sort them in ascending order.
``````

I just need a routine to count and sort with primary (ones) and secondary (value) criteria. I can convert a number to an array of ones and zeroes using `sprintf` and then `split`, I can `grep` the ones and then count how many there are. The result fits a one-liner

Example 1:

``````perl -E '
sub o(\$x){0+grep{\$_}split "", sprintf "%b",\$x}@i=@ARGV;@r=sort{o(\$a)<=>o(\$b)||\$a<=>\$b}@i;say "@i -> @r"
' 0 1 2 3 4 5 6 7 8
``````

Results:

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

Example 2:

``````perl -E '
sub o(\$x){0+grep{\$_}split "", sprintf "%b",\$x}@i=@ARGV;@r=sort{o(\$a)<=>o(\$b)||\$a<=>\$b}@i;say "@i -> @r"
' 1024 512 256 128 64
``````

Results:

``````1024 512 256 128 64 -> 64 128 256 512 1024
``````

The full code is similar.

`````` 1  # Perl weekly challenge 271
2  # Task 2:  Sort by 1 bits
3  #
5  use v5.36;
6  die <<~"FIN" unless @ARGV;
7      Usage: \$0 N1 N2...
8      to sort the numbers N1, N2... according to the number of 1 bits
9      and then according to value
10      FIN
11  my @sorted = sort {ones(\$a) <=> ones(\$b) || \$a<=>\$b} @ARGV;
12  say "@ARGV -> @sorted";
13
14  sub ones(\$x){
15      0+grep{\$_}split "", sprintf "%b",\$x;
16  }
``````

Examples:

``````./ch-2.pl 0 1 2 3 4 5 6 7 8
./ch-2.pl 1024 512 256 128 64
``````

Results:

``````0 1 2 3 4 5 6 7 8 -> 0 1 2 4 8 3 5 6 7
1024 512 256 128 64 -> 64 128 256 512 1024
``````

/;

Written on May 28, 2024