Perl Weekly Challenge 271.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 271.
Task 1: Maximum Ones
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 #
4 # See https://wlmb.github.io/2024/05/28/PWC271/#task-1-maximum-ones
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 #
4 # See https://wlmb.github.io/2024/05/28/PWC271/#task-2-sort-by-1-bits
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