Perl Weekly Challenge 253.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 253.
Task 1: Split Strings
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
Task 2: Weakest Row
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
/;
Written on January 22, 2024