Perl Weekly Challenge 229.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 229.
Task 1: Lexicographic Order
Submitted by: Mohammad S Anwar
You are given an array of strings.
Write a script to delete element which is not lexicographically sorted
(forwards or backwards) and return the count of deletions.
Example 1
Input: @str = ("abc", "bce", "cae")
Output: 1
In the given array "cae" is the only element which is not lexicographically sorted.
Example 2
Input: @str = ("yxz", "cba", "mon")
Output: 2
In the given array "yxz" and "mon" are not lexicographically sorted.
I assume that a string is not deleted if some other string has the
opposite order. I use ord and split to convert the characters of the input
strings to an array of integers (assuming ASCII), save the array, sort
it and increase the count of deletions if any element of the array and
of the revesed array changes upon sorting. I assume case is indifferent, so I normalize to
lowercase. This fits a one and a half liner:
Example 1:
perl -MPDL -MPDL::NiceSlice -E 'for(@ARGV){$z=($y=($x=pdl([map {ord} split "", lc]))->(-1:0))->qsort;
++$c if ($x!=$z)->any&&($y!=$z)->any} say "@ARGV->", $c||0;
' abc bce cae
Results:
abc bce cae->1
Example 2:
perl -MPDL -MPDL::NiceSlice -E 'for(@ARGV){$z=($y=($x=pdl([map {ord} split "", lc]))->(-1:0))->qsort;
++$c if ($x!=$z)->any&&($y!=$z)->any} say "@ARGV->", $c||0;
' yxz cba mon
Results:
yxz cba mon->2
Another example:
perl -MPDL -MPDL::NiceSlice -E 'for(@ARGV){$z=($y=($x=pdl([map {ord} split "", lc]))->(-1:0))->qsort;
++$c if ($x!=$z)->any&&($y!=$z)->any} say "@ARGV->", $c||0;
' abc cba AbC cBa
Results:
abc cba AbC cBa->0
The full code is essentially identical:
1 # Perl weekly challenge 229
2 # Task 1: Lexicographic Order
3 #
4 # See https://wlmb.github.io/2023/08/06/PWC229/#task-1-lexicographic-order
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 s1 [s2...]
10 to count how many strings s1 s2... are not lexicographically sorted.
11 Assume loer or upper case ASCII inputs.
12 FIN
13 my $count=0;
14 for(@ARGV){
15 my $z=(
16 my $y=(
17 my $x=pdl([map {ord} split "", lc]) # convert to lower case and to numbers
18 )->(-1:0) # reverse order
19 )->qsort; # increasing sort
20
21 ++$count
22 if ($x!=$z)->any # string changes upon sorting
23 &&($y!=$z)->any # reversed string changes upon sorting
24 }
25 say "@ARGV->", $count;
Example:
./ch-1.pl abc bce cae
./ch-1.pl yxz cba mon
./ch-1.pl abc cba AbC cBa
Results:
abc bce cae->1
yxz cba mon->2
abc cba AbC cBa->0
Task 2: Two out of Three
Submitted by: Mohammad S Anwar
You are given three array of integers.
Write a script to return all the elements that are present in at least 2 out of 3 given arrays.
Example 1
Input: @array1 = (1, 1, 2, 4)
@array2 = (2, 4)
@array3 = (4)
Ouput: (2, 4)
Example 2
Input: @array1 = (4, 1)
@array2 = (2, 4)
@array3 = (1, 2)
Ouput: (1, 2, 4)
To solve this task I build a hash with the number of arrays in which
each unique element has appeared. To that end, I can filter each array
with uniqint from List::Util to remove duplicates. I’ll admit more
than three arrays. Input is taken from @ARGV as a string of space
separated elements. The code fits a one liner.
Example 1:
perl -MList::Util=uniq -E '
for(@ARGV){$c{$_}++ for uniq split " ";}@o=grep {$c{$_}>=2} keys %c;say map({"[$_]"} @ARGV), "->[@o]"
' "1 1 2 4" "2 4" "4"
Results:
[1 1 2 4][2 4][4]->[2 4]
Example 2:
perl -MList::Util=uniq -E '
for(@ARGV){$c{$_}++ for uniq split " ";}@o=grep {$c{$_}>=2} keys %c;say map({"[$_]"} @ARGV), "->[@o]"
' "4 1" "2 4" "1 2"
Results:
[4 1][2 4][1 2]->[2 4 1]
The full code follows:
1 # Perl weekly challenge 229
2 # Task 2: Two out of Three
3 #
4 # See https://wlmb.github.io/2023/08/06/PWC229/#task-2-two-out-of-three
5 use v5.36;
6 use List::Util qw(uniq);
7 die <<~"FIN" unless @ARGV>=3;
8 Usage: $0 A1 A2 A3 [A4...]
9 to find which elements of the arrays A1, A2... are common to two or more arrays.
10 Each array is a string with space separated elements.
11 More than three input arrays are allowed.
12 input array
13 FIN
14 my %count;
15 for(@ARGV){
16 $count{$_}++ for uniq split " ";
17 }
18 my @output=sort {$a <=> $b} grep {$count{$_}>=2} keys %count;
19 say map({"[$_]"} @ARGV), "->[@output]"
Examples:
./ch-2.pl "1 1 2 4" "2 4" "4"
./ch-2.pl "4 1" "2 4" "1 2"
Results:
[1 1 2 4][2 4][4]->[2 4]
[4 1][2 4][1 2]->[1 2 4]
/;