# Perl Weekly Challenge 229.

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

``````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  #
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  #
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]
``````

/;

Written on August 6, 2023